Soru Kapalı dosyadan veri alma hatası

[işsiz123]

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

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

 

[işsiz123]

Hata xls dosysının bozuk olmasından kaynaklıymış. Html olarak algılıyor o dosyayı.