Makro ile güncelleştirme

[Mehmet Sait]

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.

 

[Muzaffer Ali]

Dosya isimlerinin uzantıları da vardır.
Excel hücrelerine uzantılarını da yazmanız gerekiyor.
Örnek: Sanel.xlsx

 

[Muzaffer Ali]

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.

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

 

[Mehmet Sait]

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

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.

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

 

[Muzaffer Ali]

ThisWorkbook.Path

Kodları çalıştırdığınız dosyanın klasör adresidir.
Orayı silmelisiniz.

Aşağıdaki gibi olmalı.

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

 

[Mehmet Sait]

ThisWorkbook.Path

Kodları çalıştırdığınız dosyanın klasör adresidir.
Orayı silmelisiniz.

Aşağıdaki gibi olmalı.

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.

 

[EmrExcel16]

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..

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

 

[Muzaffer Ali]

İp adresi yerine bilgisayar adını yazarak deneyin.

 

[kardelen79]

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

 

[kardelen79]

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

 

[Mehmet Sait]

İp adresi yerine bilgisayar adını yazarak deneyin.

Hocam, denedim yine açmadı.

 

[Muzaffer Ali]

Hocam, denedim yine açmadı.

O zaman kesinlikle adres yanlış. Adresi kontrol edin.
Adresi burada da paylaşır mısınız?

 

[kardelen79]

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

 

[Mehmet Sait]

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

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

 

[kardelen79]

 

[kardelen79]

3 sayfa var hepsinin ismini yazdım bu hata çıktı

 

[Muzaffer Ali]

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.

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

 

[Mehmet Sait]

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.

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

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

 

[Muzaffer Ali]

Sizin dosyalarınız sabit olduğu ve farklı klasörlerde olduğu için aşağıdaki gibi yapabilirsiniz.

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

 

[kardelen79]

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