VBA - Einlesen von xls-Dateien - kleine? Änderung

Bild

Betrifft: VBA - Einlesen von xls-Dateien - kleine? Änderung
von: WalterK
Geschrieben am: 11.08.2015 13:09:59

Hallo zusammen,
mit dem folgenden Code von Sepp lese ich xls-Dateien ein ohne diese Dateien zu öffnen. Funktioniert eigentlich ja auch tadellos.
Allerdings nicht bei solchen xls-Dateien, die von einem externen Programm generiert wurden und die beim Öffnen den Hinweis "Geschützte Ansicht" haben.
Bei solchen xls-Dateien wird beim Einlesen in 3 von 4 Fällen einfach die letzte Spalte nicht mit eingelesen.
Wenn ich die betreffenden xls-Dateien öffne, dann auf "Trotzdem bearbeiten" klicke, abspeichere und schliesse ---> dann wird alles richtig eingelesen.
Was muss im Code geändert werden, damit das Einlesen trotz "geschützter Ansicht" vollständig funktioniert.

Option Explicit
Sub Import_XLS()
    Dim wsTemp As Worksheet
    Dim objADO As Object
    Dim arrStrings(3, 1) As Variant
    Dim strPath As String, strBlatt As String
    Dim strFileGesamt As String, strRef2 As String
    Dim lngI As Long, Intc As Integer
    
    On Error GoTo ErrExit
    
    Application.ScreenUpdating = False
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
        .Cursor = xlWait
    End With
    arrStrings(0, 0) = "ErsterExport"
    arrStrings(0, 1) = "ErsterExport.xls"
    
    arrStrings(1, 0) = "ZweiterExport"
    arrStrings(1, 1) = "ZweiterExport.xls"
    
    arrStrings(2, 0) = "DritterExport"
    arrStrings(2, 1) = "DritterExport.xls"
    arrStrings(3, 0) = "VierterExport"
    arrStrings(3, 1) = "VierterExport.xls"
  
    strRef2 = "Sheet0$A:Z" 'normale Bereichsangabe unbedingt MIT Tabellenname & $-Zeichen
    strPath = "D:\EXPORTE\" 'Datenarbeitsmappe
    strBlatt = "Sheet0"
  
    For Intc = 0 To UBound(arrStrings)
        strFileGesamt = strPath & arrStrings(Intc, 1)
        Sheets(arrStrings(Intc, 0)).UsedRange.ClearContents
    
    If Dir(strFileGesamt, vbNormal) <> "" Then
        Set wsTemp = ActiveWorkbook.Worksheets.Add(After:=ActiveWorkbook.Worksheets( _
            ActiveWorkbook.Worksheets.Count))
        wsTemp.Name = "TemporäresBlatt"
      
        Set objADO = ExcelTable(strFileGesamt, strRef2)
        'Spaltennamen!
    For lngI = 1 To objADO.Fields.Count
        wsTemp.Cells(1, lngI) = Replace(objADO.Fields(lngI - 1).Name, "#", ".")
    Next
        wsTemp.Range("A2").CopyFromRecordset objADO
        objADO.Close
        Set objADO = Nothing
        
        wsTemp.Columns("A:Z").Copy Worksheets(arrStrings(Intc, 0)).Range("A1")
      
        wsTemp.Delete
'        KillFile strFileGesamt
    End If
    Next
    
ErrExit:
    With Application
        .StatusBar = False
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
        .Calculation = xlCalculationAutomatic
        .Cursor = xlDefault
    End With
         
    Set objADO = Nothing
    Set wsTemp = Nothing
End Sub
Public Function ExcelTable(ByRef Path As String, ByRef SourceRange As String) As Object
  Dim SQL As String
  Dim Con As String
  
  SQL = "select * from [" & SourceRange & "]"
  
  If Mid(Path, InStrRev(Path, ".") + 1) = "xls" Then
    Con = "Provider=Microsoft.Jet.OLEDB.4.0;" _
      & "Extended Properties=Excel 8.0;" _
      & "Data Source=" & Path & ";"
  ElseIf Mid(Path, InStrRev(Path, ".") + 1) Like "xls?" Then
    Con = "Provider=Microsoft.ACE.OLEDB.12.0;" _
      & "Extended Properties=""Excel 12.0;HDR=YES"";" _
      & "Data Source=" & Path & ";"
  Else
    Exit Function
  End If
  Set ExcelTable = CreateObject("ADODB.Recordset")
  ExcelTable.Open SQL, Con, 3, 1
End Function
Private Function KillFile(FileName As String, Optional Force As Boolean = True) As Long
  Dim objFSO As Object
  
  KillFile = -1
  
  On Error GoTo ErrExit
  
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  
  objFSO.DeleteFile FileName, Force
  
  Exit Function
  
ErrExit:
  KillFile = 0
End Function
Besten Dank im voraus, Servus, Walter

Bild

Betrifft: AW: VBA - Einlesen von xls-Dateien - kleine? Änderung
von: Michael
Geschrieben am: 11.08.2015 14:49:40
Hi Walter,
ich hab recherchiert nach
excel vba geschützte ansicht deaktivieren
und das mal überflogen; es mag hilfreich sein:
http://www.office-loesung.de/ftopic518774_0_0_asc.php
Schöne Grüße,
Michael

Bild

Betrifft: Bei deinem Link geht es aber ...
von: WalterK
Geschrieben am: 11.08.2015 16:10:18
Hallo Michael,
... um die Deaktivierung der "Geschützen Ansicht" beim Öffnen der Datei.
Ich sollte aber eine Lösung haben ohne die Datei zu öffnen.
Danke jedenfalls und Servus, Walter

Bild

Betrifft: AW: Bei deinem Link geht es aber ...
von: Luschi
Geschrieben am: 11.08.2015 18:55:34
Hallo WalterK,
das Auslesen von Excel-Dateien ohne internes Öffnen der Datei ist ein großes Märchen, welches immer wieder im Internet seine Kreise zieht, Egal ob DDE, ADODB DAO usw. - die Datei wird geöffnet, auch wenn man es so nicht sieht. So auch im Vba-Code von Sepp:
Set ExcelTable = CreateObject("ADODB.Recordset")
ExcelTable.Open SQL, Con, 3, 1
Deshalb setze Dich mit dem Link von Michael auseinander.
Gruß von Luschi
aus klein-Paris


Bild

Betrifft: Woran kann es liegen, ...
von: WalterK
Geschrieben am: 11.08.2015 19:36:32
Hallo Luschi,
...dass bei 3 von 4 Dateien alles eingelesen wird außer die letzte Spalte?
Danke und Servus, Walter

Bild

Betrifft: Ich schliesse jetzt ...
von: WalterK
Geschrieben am: 15.08.2015 21:40:27
... das Thema ab.
Eine Lösung meines Problems über den von mir geposteten Code wäre mir zwar lieber gewesen, das scheint allerdings nicht zu gehen.
Ich muss mir daher anders behelfen.
Danke jedenfalls für Euer Mitdenken.
Servus, Walter

 Bild

Beiträge aus den Excel-Beispielen zum Thema "VBA - Einlesen von xls-Dateien - kleine? Änderung"