• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro ile güncelleştirme

Merhaba,
Benzer bir sorunu bende yaşıyorum. Benim sorunum iki farklı dosyadan tabloya veri almak. Veri aldığım tabloyu her açtığımda güncelleme yapılsın mı diye soruyor. Kapalı olan iki dosyam şifreli.
Her güncelleme yaptığımda şifre yazmak yerine kapalı dosya şifrelerini tanıtmak ve makro ile güncelleme yapılabilir mi?
Yardımlarınız için teşekkür ederim.
 
Dosya isimlerinin uzantıları da vardır.
Excel hücrelerine uzantılarını da yazmanız gerekiyor.
Örnek: Sanel.xlsx
 
Merhaba,
Benzer bir sorunu bende yaşıyorum. Benim sorunum iki farklı dosyadan tabloya veri almak. Veri aldığım tabloyu her açtığımda güncelleme yapılsın mı diye soruyor. Kapalı olan iki dosyam şifreli.
Her güncelleme yaptığımda şifre yazmak yerine kapalı dosya şifrelerini tanıtmak ve makro ile güncelleme yapılabilir mi?
Yardımlarınız için teşekkür ederim.

Dosya açarken şifre de belirtilebilir.
Aşağıdaki kodda 123 yerine kendi şifrenizi yazın.

Kod:
Sub Test()
    Dim Dosya As Object
    Application.DisplayAlerts = False
    For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path & "\BİROL OYAK").Files
        If Dosya.Type = "Microsoft Excel Çalışma Sayfası" And Not Dosya.Name = ThisWorkbook.Name Then
            Workbooks.Open(Filename:=Dosya.Path, Password:="123").Close True
        End If
    Next
    Application.DisplayAlerts = True
End Sub
 
Dosya açarken şifre de belirtilebilir.
Aşağıdaki kodda 123 yerine kendi şifrenizi yazın.

Kod:
Sub Test()
    Dim Dosya As Object
    Application.DisplayAlerts = False
    For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path & "\BİROL OYAK").Files
        If Dosya.Type = "Microsoft Excel Çalışma Sayfası" And Not Dosya.Name = ThisWorkbook.Name Then
            Workbooks.Open(Filename:=Dosya.Path, Password:="123").Close True
        End If
    Next
    Application.DisplayAlerts = True
End Sub

Yardımlarınız için teşekkür ederim.

Dosyalar serverde kayıtlı. Şu şekilde düzelltim ama bulunamıyor diyor.

Kod:
Sub Test()
    Dim Dosya As Object
    Application.DisplayAlerts = False
    For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path & "\\192.168.1.242\ortak\SEVKİYAT\RAPORLAR\2022 RAPORLARI\2022 Günlük Raporlar\2022 STOK SAYIM KOLİ.xlsm").Files
        If Dosya.Type = "Microsoft Excel Çalışma Sayfası" And Not Dosya.Name = ThisWorkbook.Name Then
            Workbooks.Open(Filename:=Dosya.Path, Password:="3300").Close True
        End If
    Next
    Application.DisplayAlerts = True
End Sub
 
Kod:
ThisWorkbook.Path
Kodları çalıştırdığınız dosyanın klasör adresidir.
Orayı silmelisiniz.

Aşağıdaki gibi olmalı.
Kod:
For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder("\\192.168.1.242\ortak\SEVKİYAT\RAPORLAR\2022 RAPORLARI\2022 Günlük Raporlar\").Files
 
Son düzenleme:
Kod:
ThisWorkbook.Path
Kodları çalıştırdığınız dosyanın klasör adresidir.
Orayı silmelisiniz.

Aşağıdaki gibi olmalı.
Kod:
For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder("\\192.168.1.242\ortak\SEVKİYAT\RAPORLAR\2022 RAPORLARI\2022 Günlük Raporlar\2022 STOK SAYIM KOLİ.xlsm").Files

Teşekkür ederim hocam,

Yolu bulamadı. Aynı adresi dosya gezginine yapıştıyorum ilgili klasöre gidiyor ama kodlamada bulamıyor.
 

Ekli dosyalar

  • Adsız.png
    Adsız.png
    19.5 KB · Görüntüleme: 4
Teşekkür ederim hocam,

Yolu bulamadı. Aynı adresi dosya gezginine yapıştıyorum ilgili klasöre gidiyor ama kodlamada bulamıyor.

Bu şekilde deneyin..
Kod:
Sub Test()
    Application.DisplayAlerts = False
    Workbooks.Open "\\192.168.1.242\ortak\SEVKİYAT\RAPORLAR\2022 RAPORLARI\2022 Günlük Raporlar\2022 STOK SAYIM KOLİ.xlsm", Password:="12345"
End Sub
 
İp adresi yerine bilgisayar adını yazarak deneyin.
 
Sub Test()
Dim Bak As Long
Dim Klasor As String
Klasor = ThisWorkbook.Path & "\BİROL OYAK\"
Application.DisplayAlerts = False
With Worksheets("Sayfa2")
For Bak = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
If Dir(Klasor & .Cells(Bak, "A")) = "" Then
MsgBox "Dosya: " & Klasor & .Cells(Bak, "A") & vbLf & "Bulunamıyor. Dosya adı ve yolunu doğru yazdığınızdan emin olunuz.", vbInformation
Else
Workbooks.Open(Klasor & .Cells(Bak, "A")).Close True
End If
Next
End With
Application.DisplayAlerts = True
End Sub
 
abi en son devam ettiğim kod buydu sadece diğer sayfadaki benim belirtiğim sayfaları açıp kapatmaktı bu şekilde 300 den fazla sayfa olduğu için zaman alıyor du
 
hocam benim problemime açmak istediğim sayfaları A2:A?? hücrelerine sanel.xlsx mi yazmam gerekiyor
birde ilk formulde dosya seçili olduğu için gerek duymuyor mu uzantıya adres belirtmediğimiz formulde problem yok
 
O zaman kesinlikle adres yanlış. Adresi kontrol edin.
Adresi burada da paylaşır mısınız?

Hocam, Koprü yardımı ile başvurduğum hücre için kullandığım adresin aynısını koda yazıyorum.

Hücrede başvuru yaptığım adres :

=Z155='\\192.168.1.242\ortak\SEVKİYAT\SEVKİYAT VE STOK RAPORLARI\2022 SEVKİYAT VE STOK RAPORLARI\2022 Günlük Raporlar\[2022 STOK SAYIM KOLİ.xlsm]28.02.2022'!$Y$41


Kod:
Sub Test()
    Dim Dosya As Object
    Application.DisplayAlerts = False
    For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder("\\192.168.1.242\ortak\SEVKİYAT\SEVKİYAT VE STOK RAPORLARI\2022 SEVKİYAT VE STOK RAPORLARI\2022 Günlük Raporlar\2022 STOK SAYIM KOLİ.xlsm").Files
        If Dosya.Type = "Microsoft Excel Çalışma Sayfası" And Not Dosya.Name = ThisWorkbook.Name Then
            Workbooks.Open(Filename:=Dosya.Path, Password:="3300").Close True
        End If
    Next
    Application.DisplayAlerts = True
End Sub
 
43. mesajda yazdığım kod belirtilen klasördeki tüm Excel dosyaları için geçerlidir.
Yani siz buraya sadece klasör yolunu yazacaksınız.
Bu klasördeki tüm dosyalar açılır kaydedilir ve kapatılır.

Kod:
For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder("\\192.168.1.242\ortak\SEVKİYAT\SEVKİYAT VE STOK RAPORLARI\2022 SEVKİYAT VE STOK RAPORLARI\2022 Günlük Raporlar\").Files
 
43. mesajda yazdığım kod belirtilen klasördeki tüm Excel dosyaları için geçerlidir.
Yani siz buraya sadece klasör yolunu yazacaksınız.
Bu klasördeki tüm dosyalar açılır kaydedilir ve kapatılır.

Kod:
For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder("\\192.168.1.242\ortak\SEVKİYAT\SEVKİYAT VE STOK RAPORLARI\2022 SEVKİYAT VE STOK RAPORLARI\2022 Günlük Raporlar\").Files

Bu şekilde çalıştı hocam. Teşekkür ederim
2. dosyayı çağıramadım

Kod:
Sub Test()
    Dim Dosya As Object
    Application.DisplayAlerts = False
    For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder("\\192.168.1.242\ortak\SEVKİYAT\SEVKİYAT VE STOK RAPORLARI\2022 SEVKİYAT VE STOK RAPORLARI\2022 Günlük Raporlar\").Files
        If Dosya.Type = "Microsoft Excel Çalışma Sayfası" And Not Dosya.Name = ThisWorkbook.Name Then
            Workbooks.Open(Filename:=Dosya.Path, Password:="3300").Close True
            
    For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder("E:\Belgeler\Dosyalar\Günlük Üretim Takibi\").Files
        If Dosya.Type = "Microsoft Excel Çalışma Sayfası" And Not Dosya.Name = ThisWorkbook.Name Then
            Workbooks.Open(Filename:=Dosya.Path, Password:="2022").Close True
            
            
        End If
        

    Next
    Application.DisplayAlerts = True
End Sub
 
Sizin dosyalarınız sabit olduğu ve farklı klasörlerde olduğu için aşağıdaki gibi yapabilirsiniz.

Kod:
Sub Test()
    Application.DisplayAlerts = False
    Workbooks.Open(Filename:="\\192.168.1.242\ortak\SEVKİYAT\SEVKİYAT VE STOK RAPORLARI\2022 SEVKİYAT VE STOK RAPORLARI\2022 Günlük Raporlar\2022 STOK SAYIM KOLİ.xlsm", Password:="3300").Close True
    
    'Diğer dosyaları da üst satırdaki gibi tam yolunu yazarak yapabilirsiniz. Dikkat edin tam yolu yazacaksınız yani .xlsm de dahil
    Application.DisplayAlerts = True
End Sub
 
Benim bu formulde problem yok abi çok iyi çalışıyor ama dosyanın içindeki tüm dosyaları açıp kapatıyor ben 2 sayfa açılıp kapatılması istediğim dosyaların isimlerini yazdığımda hata veriyor onun içinde başka makro yazmıştınız o çalışmadı abi o makroyu ekleyeyim


Sub Test()
Dim Dosya As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(ThisWorkbook.Path & "\BİROL OYAK").Files
If Dosya.Type = "Microsoft Excel Çalışma Sayfası" And Not Dosya.Name = ThisWorkbook.Name Then
Workbooks.Open(Dosya.Path).Close True
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
Geri
Üst