Kapalı dosya hata

[yelgecak]

s.a üstatlar kapalı dosyadan veri alırken aşağıdaki satırda hata veriyor neden olabilir sizce.

Klasor1.Workbooks.Open (klasör_adı & yeni_dosya_adı)

Bazende başka bir ole bağlantısı bekleniyor diyor. yardımlarınızı bekliyorum.

teşekkürler

 

[halit3]

s.a üstatlar kapalı dosyadan veri alırken aşağıdaki satırda hata veriyor neden olabilir sizce.

Klasor1.Workbooks.Open (klasör_adı & yeni_dosya_adı)

Bazende başka bir ole bağlantısı bekleniyor diyor. yardımlarınızı bekliyorum.

teşekkürler

Bu kodu denermisiniz.

Private Sub CommandButton1_Click()
Dim satır As Long
Dim sutun As Long
Kaynak1 = Application.GetOpenFilename("All Files (*.*),*.*.")
If Kaynak1 = False Then
MsgBox "Veri alınacak dosyayı seçmediniz.", vbInformation, "DİKKAT"
Exit Sub
Else
End If
If Cells(1, 1).Value <> "" Then
deg1 = Cells(1, 1).Value
End If
If Cells(1, 2).Value <> "" Then
deg2 = Cells(1, 2).Value
End If
If Cells(1, 3).Value <> "" Then
deg3 = Cells(1, 3).Value
End If

a = MsgBox("Sayfayı temizliyerek  aktarsınmı.?", vbYesNo + vbInformation, c & " Rapor aktarımı")
If a = vbYes Then
Cells.ClearContents
End If
Dosya = Dir(Kaynak1)
klasör_adı = Mid(Kaynak1, 1, Len(Kaynak1) - Len(Dir(Kaynak1)))
yeni_dosya_adı = Dir(Kaynak1)
deg = "'" & klasör_adı & "[" & yeni_dosya_adı & "]" & x & "'!R"
Cells(1, 1).Value = klasör_adı
Cells(1, 2).Value = yeni_dosya_adı
Cells(1, 3).Value = "=" & deg & 1 & "C" & 1
Cells(1, 3).Replace What:="=", Replacement:=""
alan1 = Worksheets(ActiveSheet.Name).Cells(1, 3).Value
For k = 1 To Len(alan1)
If Mid(alan1, k, 1) = "]" Then
yer = (Len(alan1) - 6 - k)
zaman = Mid(alan1, k + 1, yer)
End If
Next
Cells(1, 3).Value = zaman
sayfaadi = zaman
deg = "'" & klasör_adı & "[" & yeni_dosya_adı & "]" & sayfaadi & "'!R"
If a = vbYes Then
Cells.ClearContents
End If
Dim wb As Workbook
Set wb = Workbooks.Open(klasör_adı & yeni_dosya_adı)
Set Dosya = Workbooks(yeni_dosya_adı).Sheets(sayfaadi)
On Error Resume Next
satır = Dosya.Cells.Find("*", LookIn:=xlFormulas, SearchDirection:=xlPrevious).Row
sutun = Dosya.Cells.Find("*", LookIn:=xlFormulas, SearchDirection:=xlPrevious).Column
If satır = 0 Then
MsgBox sayfaadi & Chr(10) & _
"Bu sayfada Hiç değer yok "
Klasor1.Workbooks(yeni_dosya_adı).Close
Exit Sub
End If
'MsgBox satır
'MsgBox sutun
Workbooks(yeni_dosya_adı).Close
alınan1 = 0 'verinin başlangıç satır değeri
alınan2 = 0 'verinin başlangıç sütun değeri
'bas1 = 1 'aktarılan verinin başlangıç satır değeri
If WorksheetFunction.CountA(Cells) > 0 Then
bas1 = Cells.Find("*", LookIn:=xlFormulas, SearchDirection:=xlPrevious).Row  'aktarılan verinin başlangıç satır değeri
Else
bas1 = 0
End If

bit1 = 0 'aktarılan verinin başlangıç sütun değeri
For i = 1 To satır
For j = 1 To sutun
If IsNumeric(ExecuteExcel4Macro(deg & i + alınan1 & "C" & j + alınan2)) = True Then
Cells(i + bas1, j + bit1).Value = ExecuteExcel4Macro(deg & i + alınan1 & "C" & j + alınan2) * 1
Else
Cells(i + bas1, j + bit1).Value = ExecuteExcel4Macro(deg & i + alınan1 & "C" & j + alınan2)
End If
If Cells(i + bas1, j + bit1).Value = 0 Then
Cells(i + bas1, j + bit1).Value = ""
End If
Next j
Next i
If deg1 <> "" Then
Cells(1, 1).Value = deg1
End If
If deg2 <> "" Then
Cells(1, 2).Value = deg2
End If
If deg3 <> "" Then
Cells(1, 3).Value = deg3
End If
 
MsgBox "işlem tamam"
End Sub

 

[yelgecak]

Hocam teşekkürler hatayı çözdüm. Ben kopyalanacak sayfayı internet üzerinde çalışan bi proğramdan çekiyorum Crystal Report Viewerden yani. çektiğim dosyayı açıp kaydettikten sonra hata almıyorum. dosya ham olarak yani web den çektiğim gibi durduğu zaman o satırda hata veriyor. Hocam bunun nedeni varmı ?

 

[halit3]

Hocam teşekkürler hatayı çözdüm. Ben kopyalanacak sayfayı internet üzerinde çalışan bi proğramdan çekiyorum Crystal Report Viewerden yani. çektiğim dosyayı açıp kaydettikten sonra hata almıyorum. dosya ham olarak yani web den çektiğim gibi durduğu zaman o satırda hata veriyor. Hocam bunun nedeni varmı ?

Yukarıdaki kodun görevi bilgisayarınızdaki bir excel dosyasından verileri almak içindir.Diğer taraftan web üzerindeki bir excel dosyasından veri almaz.