- Katılım
- 13 Temmuz 2016
- Mesajlar
- 613
- Excel Vers. ve Dili
- Excel 2010 & 2016 Türkçe
- Altın Üyelik Bitiş Tarihi
- 06-03-2020
Merhaba,
Aşağıdaki Kod ile kapalı excel dosyasından veri alıyorum. Ancak bir dosyada A3:F3 hücreleri birleştirilmiş olduğu için
cn.Open (cnstr) bu satırda "Dış Tablo Beklenen Biçimde Değil Uyarısı Alıyorum." Birleştirilmiş satırı kaldırdığımda hata vermeden bilgileri getiriyor.
Bu hatayı nasıl geçebiliriz. Şimdiden Teşekkürler
Aşağıdaki Kod ile kapalı excel dosyasından veri alıyorum. Ancak bir dosyada A3:F3 hücreleri birleştirilmiş olduğu için
cn.Open (cnstr) bu satırda "Dış Tablo Beklenen Biçimde Değil Uyarısı Alıyorum." Birleştirilmiş satırı kaldırdığımda hata vermeden bilgileri getiriyor.
Bu hatayı nasıl geçebiliriz. Şimdiden Teşekkürler
Kod:
Sub DosyaOku()
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim fd As Office.FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = False
.Filters.Clear
.Title = "Select a Excel File"
.Filters.Add "Excel Documents", "*.xls;*.xlsx;*.xlsm", 1
If .Show = True Then
ExcelDosyaAdi = Dir(.SelectedItems(1))
ExcelDosyaYolu = .InitialFileName
Else
Exit Sub
End If
End With
Set cn = CreateObject("adodb.connection")
Set Rs = CreateObject("adodb.recordset")
cnstr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ExcelDosyaYolu & ExcelDosyaAdi & ";Extended Properties=""Excel 12.0 Macro;HDR=NO"""
cn.Open (cnstr)
S1 = "[Excel 12.0 Macro;HDR=NO;Database=" & ExcelDosyaYolu & ExcelDosyaAdi & "].[hesaphareketleri$]"
Sorgu = "select F1,F2,F3,F4 from " & S1
Set Rs = cn.Execute(Sorgu)
sat = 1
Range("A:B") = ""
'Range("A2") = "Exc_Açıklama": Range("B2") = "Exc_Tutar"
If Not Rs.EOF Or Not Rs.BOF Then
Rs.MoveFirst
Do While Not Rs.EOF
If Format(Rs(3), "#,##0.00") < 0 Then
Else
Range("A" & sat) = Right(Rs(1), 10)
Range("B" & sat) = Format(Rs(3), "#,##0.00")
sat = sat + 1
End If
Rs.MoveNext
Loop
End If
cn.Close
End Sub