Şifreli dosyadan veri alınırmı.

[mozdem]

Kapalı veri dosyam (Araçlar>>Seçenekler>>Güvenlik sekmesindeki Açma Parolası) Dosya açma parolası ile korunmuştur. (parola :123)
Veri alacağım dosyadan açma parolası olan kapalı dosyamdan nasıl veri alabilirim ve yazdırabilirim.
Teşekkürler.

 

[Zeki Gürsoy]

Proseduru aşağıdaki gibi değiştirirseniz şifreli kapalı dosyadan veri alabilirsiniz. Yani dosyanın fiziksel olarak açılması gerekiyor.. Değişiklikler koyu vurgudadır.

Sub kapali_aktar()
[B]Application.ScreenUpdating = False

Dim cWb As Workbook, oWb As Workbook[/B] [B]

Set oWb = ThisWorkbook[/B] [B]

Set cWb = Workbooks.Open( _[/B] [B]
    ThisWorkbook.Path & "\Veridosyam.xls", _
    Password:="123")[/B]

[B]oWb.Activate[/B]

Dim conn As Object, rs As Object
Set conn = CreateObject("AdoDb.Connection")
Set rs = CreateObject("AdoDb.Recordset")

Dim KapalıDosyaAd As String
Dim KapalıSayfaAd As String
Dim BazHücre
Dim SatNo As Integer
Dim SutNo As Integer
Dim SuzVeri As Double

[B]oWb.Worksheets("kapalı").[/B]Range("A4:K2000").ClearContents

'------- VERİLER --------------------------
KapalıDosyaAd = "VeriDosyam.xls"
KapalıSayfaAd = "AnaSayfa"
BazHücre = [B]oWb.Worksheets("kapalı").[/B]Range("D1").Value 'Süzme yapmak istenilen hücredeki isim
'------------------------------------------

conn.Open "Provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path & _
"\" & KapalıDosyaAd & ";extended properties=""excel 8.0;hdr=yes;max=1"""

rs.Open "Select * from [" & KapalıSayfaAd & "$] where Metin1='" & _
[B]oWb.Worksheets("kapalı").[/B]Range("D1").Value & "' and Metin2='" & _
[B]oWb.Worksheets("kapalı").[/B]Range("F1").Value & "' and Tarih1>=" & _
CDbl([B]oWb.Worksheets("kapalı").[/B]Range("B1").Value) & "and tarih2<=" & _
CDbl([B]oWb.Worksheets("kapalı").[/B]Range("B2").Value) & ";", conn, 1, 3

sat = [B]oWb.Worksheets("kapalı").[/B]Cells(65536, "A").End(xlUp).Row + 1
rs.movefirst

[B]oWb.Worksheets("kapalı").[/B]Range("A" & sat).CopyFromRecordset rs

rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing

[B]cWb.Close False
Set oWb = Nothing
Set cWb = Nothing
Application.ScreenUpdating = True[/B]
End Sub

 

[mozdem]

Teşekkürler

Proseduru aşağıdaki gibi değiştirirseniz şifreli kapalı dosyadan veri alabilirsiniz. Yani dosyanın fiziksel olarak açılması gerekiyor.. Değişiklikler koyu vurgudadır.

Sub kapali_aktar()
[B]Application.ScreenUpdating = False

Dim cWb As Workbook, oWb As Workbook[/B] [B]

Set oWb = ThisWorkbook[/B] [B]

Set cWb = Workbooks.Open( _[/B] [B]
    ThisWorkbook.Path & "\Veridosyam.xls", _
    Password:="123")[/B]

[B]oWb.Activate[/B]

Çok Teşekkür ederim Zeki hocam, Ellerinize Sağlık