Thema Datum  Von Nutzer Rating
Antwort
18.11.2024 08:03:12 Paul
Solved
Blau Fehler in VBA-Code / Dir-Funktion
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:
ralf_b
Datum:
19.11.2024 00:30:01
Views:
66
Rating: Antwort:
 Nein
Thema:
Fehler in VBA-Code / Dir-Funktion

Da dieser Code uralt ist und größtenteills nicht von dir stammt, verstehst du ihn möglicherweise nicht gänzlich.

bei welchem Error landest du? Es gibt ne ganze Menge. Dieser Code wurde für ccd Dateien geschrieben. Verwendest du ihn auch dafür? Hast du die Schleife eingebaut oder eine KI? Der Code öffnet eine Xml datei in Excel: löscht leere Zeilen und einen Bereich in der Xmldatei. Die selbe Datei wir dann als csv gespeichert.  
Du willst aber etwas ganz Anderes. Und hier beginnt das Problem. Denn der Code müßte die erste Datei öffnen, den Bereich löschen, und entweder den Rest in eine neuen Datei kopieren oder die erste Datei dazu zu nutzen, um die Inhalte der folgenden Dateien dort hinein zu kopieren und dann diese erste Datei als Csv zu speichern.  

 Hier mein Versuch, aber ungetestet. Wenns nicht funktioniert, Pech gehabt. Ohne die passenden Dateien ist das nur ein Ratespiel.   

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
    Dim firstWB As Workbook
    Dim aktualWB As Workbook
    
     ' 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"
    
    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
        if  pFlPthSel = "" then exit sub 'Abbruch wenn nichts gefunden  
       
       ' Open the selected XML file
        If firstWB Is Nothing Then 
           Set firstWB = Workbooks.OpenXML(Filename:=pFlPthSel, Stylesheets:=Array(1))
        Else
           Set aktualWB = Workbooks.OpenXML(Filename:=pFlPthSel, Stylesheets:=Array(1))
        End If
        
        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 = .Cells(.Rows.Count, 1).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
            
        If ActiveWorkbook = aktualWB Then
           'usedrange in firstwb kopieren
           ActiveSheet.UsedRange.Copy firstWB.Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Offset(1)
           aktualWB.Close savechanges:=False
        End If
        
        pFlPthSel = Dir() 'wählt die nächste Datei
    
    Loop Until pFlPthSel = "" 'beendet die Schleife nach der letzten Datei
    
        
        ' 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
        firstWB.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
   

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
18.11.2024 08:03:12 Paul
Solved
Blau Fehler in VBA-Code / Dir-Funktion
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