Thema Datum  Von Nutzer Rating
Antwort
Rot Fehler in VBA-Code / Dir-Funktion
18.11.2024 08:03:12 Paul
Solved
19.11.2024 00:30:01 ralf_b
Solved
19.11.2024 13:08:23 Paul
NotSolved
19.11.2024 12:21:42 Gast72811
NotSolved
Rot 1
21.11.2024 09:14:12 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:13 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:13 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:14 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:14 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:14 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:15 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:15 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:16 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:16 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:16 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:17 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:17 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:18 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:18 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:18 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:19 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:19 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:20 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:21 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:22 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:22 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:23 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:23 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:24 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:24 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:25 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:25 lxbfYeaa
NotSolved
Rot Rot 1
21.11.2024 09:14:26 lxbfYeaa
NotSolved

Ansicht des Beitrags:
Von:
Paul
Datum:
18.11.2024 08:03:12
Views:
147
Rating: Antwort:
 Nein
Thema:
Fehler in VBA-Code / Dir-Funktion

Liebe Community,

ich hab hier mit Google-Hilfe ein Projekt erstellt, das XML-Dateien in CSV-Dateien umwandeln soll, was soweit auch super funktioniert. Aber: Nicht für eine Datei, sondern für alle Dateien in einem Ordner, wofür ich die Dir-Funktion gefunden habe. Allerdings funktioniert es damit nicht, ich lande immer beim Error.

Die nächste Frage wäre dann noch: Das Projekt würde aus jeder Datei eine eigene CSV-Datei erstellen. Ich brauche aber alle Inhalte in einer einzigen CSV-Datei, untereinander. Wie geht das?

Vielen Dank für jede Hilfe!

Paul

 

Hier der Code: (irgendwie hab ich das mit der Quellcode-Funktion nicht geschafft)


Option Explicit

Sub XMLinCSV()
    
    Dim LstRw As Long
    Dim c As Integer
    Dim pFlPthSel
    Dim FlNmCSV As String
    Dim FndToC As Range, FndTrnCr As Range
    
pFlPthSel = Dir("C:\Users\Buchhaltung\Desktop\CCD_Converter\Neuer Ordner\*.xml")
Do 'Dein Makro kann nun Datei x öffnen und bearbeiten und wieder schließen
    
    ' Don't update the screen or show alerts
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    ActiveSheet.ScrollArea = "a1"
    ' Go to error message if there's a problems opening the selected XML or XSL
    On Error GoTo NotOpened
    ' Displays the standard Open dialog box and gets a file name from user without actually opening any files.
    ' The XML files in the current folder are displayed
    
    
    'ChDir ActiveWorkbook.Path
    'pFlPthSel = Application.GetOpenFilename("XML Files (*.xml),*.xml", , "Select XML file", , False)
    'pFlPthSel = "C:\Users\Buchhaltung\Desktop\Download-Paket_20241101-20241112 CAMT\test"
    
    ' Open the selected XML file
    Workbooks.OpenXML Filename:=pFlPthSel, Stylesheets:=Array(1)
    On Error GoTo 0
    ' Excel opens the XML file as a formatted CCD in the active worksheet
    With ActiveSheet
        ' Define the row number of the last populated cell
        LstRw = .Range("A65536").End(xlUp).Row
        ' Get rid of all hyperlinks
        .Cells.Hyperlinks.Delete
        ' Delete each blank row
        For c = LstRw To 1 Step -1
            With ActiveSheet.Range("A" & c)
                If Len(.Value) = 0 And .End(xlToRight).Column > 255 Then
                    .EntireRow.Delete
                End If
            End With
        Next c
        ' Find the table of contents row
        Set FndToC = .Range("a2:a" & LstRw).Find("Table of Contents", LookIn:=xlValues, LookAt:=xlWhole)
        If Not FndToC Is Nothing Then
            ' Find the last label in the table of contents ("Transfer of care")
            Set FndTrnCr = .Range("a2:a" & LstRw).Find("Transfer of care", LookIn:=xlValues, LookAt:=xlWhole)
            If Not FndTrnCr Is Nothing Then
                ' Delete the entire table of contents rows
                .Range(FndToC.Address & ":" & FndTrnCr.Address).EntireRow.Delete
            End If
        End If
    End With
    ' Define the name for the newly created file by replacing the "xml" extention with "csv"
    FlNmCSV = Left(pFlPthSel, Len(pFlPthSel) - 3) & "csv"
    ' Save the active workbook as a csv
    ActiveWorkbook.SaveAs Filename:=FlNmCSV, FileFormat:=xlCSV, CreateBackup:=False
    ' Close the active workbook
    ActiveWindow.Close
    ' Display a message showing the path of were it's saved
    
    ' Call MsgBox("A CSV file was just created in " & FlNmCSV, vbInformation, Application.Name)
    
    ' Turn on screen updating and show alerts
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    ' Set variable to nothing
    Set FndToC = Nothing
    Set FndTrnCr = Nothing
    Exit Sub
    ' If there's an error display the following message
NotOpened:
    On Error GoTo 0
    Call MsgBox("The CCD XML file you selected is either corrupt, not a CCD file, or is missing its style sheet." _
                & vbCrLf & "" _
                & vbCrLf & "Make sure the corresponding XSL file is in the same folder as the XML file and try again." _
                , vbCritical, "Error Opening File")
    Application.ScreenUpdating = True
    ' Set variable to nothing
    Set FndToC = Nothing
    Set FndTrnCr = Nothing
    
pFlPthSel = Dir() 'wählt die nächste Datei
Loop Until pFlPthSel = "" 'beendet die Schleife nach der letzten Datei

End Sub


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Fehler in VBA-Code / Dir-Funktion
18.11.2024 08:03:12 Paul
Solved
19.11.2024 00:30:01 ralf_b
Solved
19.11.2024 13:08:23 Paul
NotSolved
19.11.2024 12:21:42 Gast72811
NotSolved
Rot 1
21.11.2024 09:14:12 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:13 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:13 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:14 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:14 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:14 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:15 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:15 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:16 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:16 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:16 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:17 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:17 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:18 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:18 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:18 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:19 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:19 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:20 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:21 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:22 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:22 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:23 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:23 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:24 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:24 lxbfYeaa
NotSolved
Rot 1
21.11.2024 09:14:25 lxbfYeaa
NotSolved
Blau 1
21.11.2024 09:14:25 lxbfYeaa
NotSolved
Rot Rot 1
21.11.2024 09:14:26 lxbfYeaa
NotSolved