E-Fatura Kurum Listesi

E Fatura'ya kayıtlı Kurumların listesini ListBox'ta görüntüleyip arama yapabilirsiniz. 

Faydalı olması dileğiyle... 

[img] [/img]

■ Module kodları;
Public Dosya_Yolu As String, Desk As String, Rky As Object

Sub Baglan()
    Set Rky = CreateObject("adodb.connection")
    Rky.Open "provider=microsoft.ace.oledb.12.0; data source=" & _
    Dosya_Yolu & ";extended properties=""Excel 12.0;hdr=yes"""
End Sub

Sub Emre()
    UserForm1.Show
End Sub

■ UserForm kodları;
Private Declare Function Dosya_Indir Lib "urlmon" Alias "URLDownloadToFileA" _
    (ByVal pCaller As Long, ByVal Adres As String, ByVal Dosya_Adı As String, _
    ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long

Private Sub CommandButton1_Click()
    Dim rs As Object, Sorgu As String, Dosya_Adresi As String, Ac As Workbook
    Set rs = CreateObject("adodb.recordSet")
    Sorgu = "Select [Kurum Unvanı] from [EFatura - Kurumlar$]"
    rs.Open Sorgu, Rky, 1, 1
    ListBox1.Column = rs.getrows
    Label2.Caption = ListBox1.ListCount & " Adet Kurum Listelendi."
    rs.Close
    Set rs = Nothing: Sorgu = ""
End Sub

Private Sub UserForm_Activate()
    Application.ScreenUpdating = False
    Desk = CreateObject("Wscript.Shell").specialfolders("Desktop")
    If Dir(Desk & "\efatura_kurumlar.xls") <> "" Then Kill Desk & "\efatura_kurumlar.xls"
    Dosya_Yolu = Desk & "\efatura_kurumlar.xls"
    Dosya_Adresi = "http://sorgu.efatura.gov.tr/kullanicilar/oliste.php?bolum=asltd&xls"
    Dosya_Indir 0&, Dosya_Adresi, Dosya_Yolu, 0&, 0&
    Application.DisplayAlerts = False
    Set Ac = Workbooks.Open(Dosya_Yolu)
    ActiveWorkbook.SaveAs Filename:=Dosya_Yolu, FileFormat:=xlExcel8, _
    Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    Ac.Close False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Call Baglan
End Sub

Private Sub Textbox1_Change()
    Dim Evn As Object, s As String
    Call Baglan
    Set Evn = CreateObject("adodb.recordset")
    Evn.Open "Select [Kurum Unvanı] from [EFatura - Kurumlar$] where [Kurum Unvanı] LIKE '%" & TextBox1.Text & "%'", Rky, 1, 1
    ListBox1.Clear
    If Evn.RecordCount > 0 Then
        ListBox1.Column = Evn.getrows
    End If
    Evn.Close
End Sub

Private Sub UserForm_Terminate()
    Rky.Close
    Set Rky = Nothing
End Sub

■ Gerekli nesneler:
1 Adet UserForm
1 Adet ListBox
1 Adet TextBox
1 Adet CommandButton

 [url= http://www.excelvba.net/download/file.php?id=20658 ]Dosyayı buradan da indirebilirsiniz[/url]

-------------------------------------------------------------------------------------------------------------------------------------------------------

■ Ayrıca XML dosyasından veri alma ile ilgili şu alternatif çalışma da kullanılabilir;

[img] [/img]

■ UserForm kodları;