kapalı dosyadan veri alma ve güncelleme

[İhsan Tank]

s.a. arkadaşlar
benim istediğim şu :
AASAYIŞ FATURALARI CARİ BAKİYELER kitabının
A4'den sonra klasörde bulunan dosyalardaki H4 hücresindeki bilgi
B4'den sonra klasörde bulunan dosyalardaki H3 hücresindeki bilgi'ler gelsin istiyorum.
ayrıca klasöre yeni ekleme yaptığımda buradaki bilgilere o dosyadaki bilgiler'de gelsin. umarım anlatabilmişimdir.
birde dosyadaki verileri istediğim zaman güncelleştirebilmeliyim

 

[Ferhat Pazarçevirdi]

Merhabalar

Aşağıdaki kodu; "AAA SATIŞ FATURALARI ZITTIRI PITTIRI.xls" dosyasında bulunan; "--GENEL" sheetinin kod sayfasına kopyalayınız.

Kodlarda AA2 hücresi, geçmişte kullandığınız dosya yolunu tutmaktadır. Eğer burası boş ise veya barındırdığı dizin geçerli değil ise; size bir dizin seçim ekranı getirir. Buradan uygun bir dizin seçmelisiniz

Uygun dizin; müşteri dosyalarının tutulduğu klasördür.

Yani ben örneğinizdeki zip dosyayı, masaüstüne çıkardım ve dizin listesinden; masaüstündeki "Kapalı" dizinin altındaki "Yeni Klasör"ü işaretleyerek bu adımı geçtim.

Kodu çalıştırınca mantığını anlayacaksınız zaten.

ÖNEMLİ NOT (Aman ha!!!) : Kodları "--GENEL" kod sayfasına yapıştırdıkran sonra (ve çalıştırmadan önce); Tools->References komutunu vererek; "Microsoft Scripting Runtime" kütüphanesini işaretlemelisiniz.

Private Sub CommandButton2_Click()
    Dim rNg As Range 'Dosya yolunun kayıtlı olduğu hücre
    Dim i As Integer
    Dim iStr As Integer
    Dim oFso As New FileSystemObject
    Dim oDzn As Folder
    Dim oDsy As File
    
    Set rNg = Range("AA2")

fpc:

    If Len(rNg) > 0 Then
        If oFso.FolderExists(rNg.Text) Then
            Set oDzn = oFso.GetFolder(rNg.Text)
            i = 3
            If oDzn.Files.Count > 0 Then
                iStr = Cells(65536, 1).End(xlUp).Row
                Range("A4:B" & iStr).ClearContents
                For Each oDsy In oDzn.Files
                    i = i + 1
                    Cells(i, 1) = ExecuteExcel4Macro("'" & rNg.Text & "\[" & oDsy.Name & "]1'!R4C8")
                    Cells(i, 2) = ExecuteExcel4Macro("'" & rNg.Text & "\[" & oDsy.Name & "]1'!R3C8")
                Next
            Else
                MsgBox "İlgili dizinin altında hiç dosya bulunamadı" & vbLf & "Sayfadaki veriler halen korunuyor", vbInformation, "Bilgilendirme"
                Exit Sub
            End If
        Else
            If MsgBox("Kayıtlı dizin bulunamadı" & vbLf & "Yeni bir dizin seçmek ister misiniz ?", vbYesNo, "Uyarı") = vbYes Then
                rNg = DizinBul
                GoTo fpc
            Else
                Exit Sub
            End If
        End If
    Else
        rNg = DizinBul
        GoTo fpc
                
    End If
        
End Sub

Function DizinBul() As String
    Dim shl As Object
    Set shl = CreateObject("Shell.Application"). _
              BrowseForFolder(0, _
                             "Lütfen bir klasör seçin !", _
                             &H100)
    If shl Is Nothing Then
        MsgBox "Herhangi bir klasör seçilmedi" & vbLf & _
               "Bu nedenle, varolan bilgiler korunacak", vbExclamation, "UYARI"
        End
    Else
        DizinBul = shl.self.Path
    End If
    Set shl = Nothing
End Function

 

[İhsan Tank]

hocam çok teşekkür ederim.
allah razı olsun