json Datei automatisch umbenennen - VBA

[Noob55]

Hallo zusammen,

ich habe eine Liste mit tausenden json Dateien dessen Dateitypen umbenennt werden müssen.
Vorab, den Texteditor können wir leider nicht direkt benutzen, da der zu verändernde Typ in der JSON zu sehen und variabel ist. 
{
  "id": "1d0a1f9f-0dfa-426a-9f53-be5e7e6bb6ad",
  "fileName": "G_00_11_F_0006_00SK_1606_Notes-pre-assessment-potential.DOCX",
  "contentType": "application/vnd.openxmlformats-officedocument.wordprocessingml.document",
  "fileSize": 41950
}

So schaut die Datei im Editor aus. Manuell würde ich jetzt die Datei aufmachen die Endung DOCX sehen und die Datei umbenennen nach Docx.
Wie löse ich das über VBA? Im ersten Schritt müsste man alle Dateien in einer Schleife öffnen.

Hierzu folgende Idee:
Sub Dateien_nacheinander_oeffnen()
    Dim cDir As String
    Dim sPath As String
   
    sPath = C\...
    cDir = Dir(sPath & "*json*")
   
    Do While cDir <> ""
        Workbooks.Open (sPath & cDir)
                                                                            ' Änderungen im Worksheet vornehmen
        
        ActiveWorkbook.SaveAs "C:\..." & cDir
        ActiveWorkbook.Close False
       
        'naechste Datei lesen
        cDir = Dir
    Loop
End Sub

Jetzt müsste (so denke ich) nach dem öffnen der Datei nach "file Name" gesucht werden und alles zwischen den Gänsefüßchen übernommen und untereinander in einer Spalte aufgelistet werden. Der Rest wäre dann nur noch REN alter File Name | Neuer FileName im Editor.

Aber das ist auch nur mein Ansatz. Andere Vorschläge oder Ideen sind herzlich willkommen!

Grüße
Ilyas

[Fennek]

Hallo,

sehr allgemein gesagt: VBA ist für json-Dateien denkbar schlecht geeignet. Python bzw Powershell z.B. sind da jahrzente weiter.

Aus der Beschreibung ist mir nicht klar geworden, welche Dateien vorliegen: Ist die gezeigte json - Struktur ein Pointer für eine andere Datei?

Ist es möglich ein Beispiel hochzuladen?

mfg

---

wenn man den gezeigten Code als 'json.txt' speichert, geht in Powershell

Code:

$foo = get-content -raw -Path C:\Users\xxx\Desktop\json.txt | ConvertFrom-Json
$foo.id
$foo.fileName

[Kuwer]

Hallo Ilyas,

so vielleicht?

Modul Modul4

Option Explicit 
 
Sub Dateien_nacheinander_umbenennen() 
    Dim lngA As Long, lngE As Long 
    Dim sDir As String, sPath As String 
    Dim sTextRein As String 
        
    sPath = "C:\Users\ilyas\Desktop\Test\" 
    sDir = Dir(sPath & "*.json") 
    Do While sDir <> "" 
      sTextRein = dat_ReadText(sPath & sDir) 
      lngA = InStr(1, sTextRein, Chr(34) & "fileName" & Chr(34) & ": " & Chr(34)) 
      If lngA Then 
        lngE = InStr(lngA + 1, sTextRein, Chr(34) & ",") 
        If lngE Then 
          Name sPath & sDir As sPath & Mid(sTextRein, lngA + 13, lngE - lngA - 13) 
        End If 
      End If 
      'naechste Datei lesen 
      sDir = Dir 
    Loop 
End Sub 
 
Public Function dat_ReadText(DerPfad As String) As String 
'https://www.online-excel.de/excel//singsel_vba.php?f=49 
  Dim sText As String, iFrei As Integer, i As Long 
  On Error GoTo Fehler 
  sText = "" 
  iFrei = FreeFile 
  Open DerPfad For Binary Access Read As #iFrei 
  i = LOF(iFrei) 
  sText = String(i, 0) 
  Get #iFrei, , sText 
  Close #iFrei 
  dat_ReadText = sText 
  Exit Function 
Fehler: 
  MsgBox Err.Description 
End Function 

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 14 - mit VBAHTML 12.6.0

Gruß Uwe

[Noob55]

Hallo Uwe,

du bist seit Tagen mein Retter in Not  :18: 
Der Code funktioniert.



fast...

Ich habe eine Fehlermeldung (Laufzeit 58) dass eine Datei bereits existiert. 
Ich würde jetzt die Namen in eine Excel importieren und die Doppelten manuell entfernen, allerdings sind einige Dateien schon umgewandelt
Gibt es eine Möglichkeit mein Makro wieder zurückzusetzen? Oder alternativ - und da wärst du jetzt an der Reihe - die Fehlermeldung dadurch zu umgehen, dass er die Datei dennoch umwandelt. Ich habe mir den Code ja wirklich angeguckt aber ich habe absolut nichts verstanden, ansonsten würd ich da selber rumbasteln...


Beste Grüße
Ilyas

---

Nein da stimmt was nicht ich hatte noch den Orginalen Ordner, da habe ich die Namen in eine Excel kopiert und über bedingte Formatierung geschaut ob da ein wert doppelt ist und es gab kein Ergebnis.

---

Kann es denn sein, dass ein und die Selbe Word/Excel Datei in 2 unterschiedlichen jsons enthalten ist?

[Noob55]

Hallo Fenek,

leider kenn ich mich mit Powershell garnicht aus und ehrlich gesagt reicht mir im Moment VBA auch  :23: 
Braucht es lange mich da einzuarbeiten? Der Code scheint ja verblüffend einfach zu sein.

Ich weiß nicht genau was du mit einem Pointer meinst, aber die Benenne ich die json um in den Typen was auch in dem Editor steht, erhalte ich die Ursprungsdatei - also eine Word oder Excel.
Leider kann ich keine Beispieldatei hochladen, da sich dort unternehmensbrisante Informationen befinden...


Beste Grüße
Ilyas

[Fennek]

eine json-Datei ist eine Text-Datei, auch wenn die umbenenntwird, wird daraus keine Excel/Word Datei.

Man kann nur die Dateinamen auslesen und diese Excel/Word Dateien dann öffnen/umbennen etc

Einfach gesagt, die gezeigt json beschreibt eine Word-Datei, die aber separat existiert.

[schauan]

Hallöchen,

prüfe vor dem Umbenennen, ob die Datei schon existiert und lösche sie:

If Dir(sPath & Mid(sTextRein, lngA + 13, lngE - lngA - 13)) <> "" then Kill sPath & Mid(sTextRein, lngA + 13, lngE - lngA - 13)

Lege aber sicherheitshalber vorher eine Kopie der Dateien an

[schauan]

Hallöchen,

… oder benenne eine Datei um, indem Du Datum und Zeit der Umbenennung hinzufügst.

Falls eine Datei in der json mehrach genannt ist, könntest Du auch zuerst die Dateinamen in eine Collection geben und diese dann abarbeiten. Wenn Du bei einer Collection den Schlüssel verwendest, werden keine doppelten Einträge zugelassen. Geht m.E. schneller, als wenn Du ein Array füllst und auf Duplikate prüfst.

Sub test()
Dim colA As New Collection
colA.Add "C:\Users\xxx\Desktop\json.txt ", "C:\Users\xxx\Desktop\json.txt "
'beim 2. mal kommt ein Fehler ...
colA.Add "C:\Users\xxx\Desktop\json.txt ", "C:\Users\xxx\Desktop\json.txt "
End Sub

Was mich allerdings an Deiner Aufgabenstellung wundert, ist, dass Du eine DOCX in eine Docx umbenennen willst.

Du möchtest also aus der
"G_00_11_F_0006_00SK_1606_Notes-pre-assessment-potential.DOCX"
eine
"G_00_11_F_0006_00SK_1606_Notes-pre-assessment-potential.Docx"
machen?

Da sollte eigentlich kein Fehler kommen, dass die Datei schon existiert.

[Kuwer]

Hallo André,

ich hatte ja gehofft, dass sich der TE zu Fenneks Einwand nochmal äußert und deshalb gewartet (und es schließlich vergessen).
Auf jeden Fall will der TE keine Dateien killen.

Mein Vorschlag wäre die Dokumentation der Konflikte in einem neuen Workbook:

Option Explicit

Sub Dateien_nacheinander_umbenennen()
    Dim i As Long
    Dim lngA As Long, lngE As Long
    Dim sDir As String, sPath As String
    Dim sTextRein As String
    ReDim sMehrfacheNamen(1 To 2, 1 To 1) As String
    
    sPath = "C:\Users\ilyas\Desktop\Test\"
    sDir = Dir(sPath & "*.json")
    On Error Resume Next
    Do While sDir <> ""
      sTextRein = dat_ReadText(sPath & sDir)
      lngA = InStr(1, sTextRein, Chr(34) & "fileName" & Chr(34) & ": " & Chr(34))
      If lngA Then
        lngE = InStr(lngA + 1, sTextRein, Chr(34) & ",")
        If lngE Then
          Name sPath & sDir As sPath & Mid(sTextRein, lngA + 13, lngE - lngA - 13)
          If Err.Number = 58 Then
            ReDim Preserve sMehrfacheNamen(1 To 2, 1 To UBound(sMehrfacheNamen, 2) + 1)
            sMehrfacheNamen(1, UBound(sMehrfacheNamen, 2)) = sDir
            sMehrfacheNamen(2, UBound(sMehrfacheNamen, 2)) = Mid(sTextRein, lngA + 13, lngE - lngA - 13)
            Err.Clear
          End If
        End If
      End If
      'naechste Datei lesen
      sDir = Dir
    Loop
    On Error GoTo 0
    If UBound(sMehrfacheNamen, 2) > 1 Then
      sMehrfacheNamen(1, 0) = "JSON-Datei"
      sMehrfacheNamen(2, 0) = "Enthaltener Dateiname"
      Workbooks.Add(xlWBATWorksheet).Worksheets(1).Cells(1).Resize(UBound(sMehrfacheNamen, 2), UBound(sMehrfacheNamen, 1)).Value = Application.Transpose(sMehrfacheNamen)
    End If
End Sub

Public Function dat_ReadText(DerPfad As String) As String
'https://www.online-excel.de/excel//singsel_vba.php?f=49
  Dim sText As String, iFrei As Integer, i As Long
  On Error GoTo Fehler
  sText = ""
  iFrei = FreeFile
  Open DerPfad For Binary Access Read As #iFrei
  i = LOF(iFrei)
  sText = String(i, 0)
  Get #iFrei, , sText
  Close #iFrei
  dat_ReadText = sText
  Exit Function
Fehler:
  MsgBox Err.Description
End Function

Gruß Uwe

[snb]

PHP-Code:

Sub M_snb()
   sn=split(createobject("wscript.shell").exec("cmd /c dir ""G:\OF\*.json"" /b/s").stdout.readall,vbcrlf)

   with createobject("scripting.filesystemobject")
      for j=0 to ubound(sn)-1
       .createtextfile(replace(snIj),".json","_neu.json").write replace(.opentextfile(sn(j)).readall,".DOCX",".Docx")
      next
   end with
End Sub