Microsoft Office Forum [ www.Office-Fragen.de ] >> READONLY <<
Microsoft Office 2003-2019 => Excel => Thema gestartet von: inane am Februar 24, 2018, 17:11:09 Nachmittag
Titel: Office 2016 Textdateien automatisch generieren aus Exceldateien - Fehler in bestehendem VBA
Beitrag von: inane am Februar 24, 2018, 17:11:09 Nachmittag
Hallo,
es hat mir jemand folgendes untenstehendes VBA Script geschrieben welches folgenden Zweck erfüllt: Es wird eine Textdatei generiert mit Dateinamen Office365_"fortlaufende Nummer"
Gleichzeitig wird abgefragt was die letzte bestehende Nummer der letzten Textdatei im Zielordner ist.
In der Textdatei enthalten sind einige Daten der jeweiligen Zeile. Im Grunde handelt es sich um Logindaten. Täglich kommen in der Exceldatei neue Logindaten hinzu und ich generiere dann immer neue Textdateien die dann verschickt werden.
Dies hat bis vor kurzem problemlos funktioniert, nur seit heute erhalte ich folgende Fehlermeldung:
Microsoft Visual Basic Laufzeitfehler 13: Typen unverträglich
Gehe ich auf Debuggen ist folgende Zeile gelb markiert: "If Trim(rng) <> "" And Trim(rng.Offset(0, 20)) <> "" And Trim(rng.Offset(0, 21)) <> "" And Trim(rng.Offset(0, 22)) <> "" Then"
Da das Script bis gestern problemlos mehrere Wochen funktioniert hat, gehe ich davon aus, dass in der exceldatei irgendwelche Daten enthalten sind seit gestern, die das Problem verursachen und das Problem nicht vom Script selbst kommt. Ich habe meine exceldatei durchgeforstet, mir fällt aber absolut nichts auf.
Kann mir irgendwer einen Tipp geben wonach ich suchen sollte in meiner excel-file?
Das gesamte Script seht ihr unten.
Vielen Dank im Vorraus & LG inane
Option Explicit
Private Const Speicherpfad As String = "C:\Users\admin\CloudStation\Office365_Lizenzen\" ' <<<< \ am ende nicht vergessen
Public Sub Passwortdateien_erstellen() Dim Lz As Long, rng As Range, Dateiname As String, Mem As String, Anzahl As Integer
With ThisWorkbook.Worksheets("Liste") Lz = .Cells(.Rows.Count, 1).End(xlUp).Row If Lz < 2 Then Exit Sub
For Each rng In .Range("A2:A" & Lz & "") If Trim(rng) <> "" And Trim(rng.Offset(0, 20)) <> "" And Trim(rng.Offset(0, 21)) <> "" And Trim(rng.Offset(0, 22)) <> "" Then Dateiname = "Office365_" & Trim(rng) & ".txt" If Datei_vorhanden(Speicherpfad & Dateiname) = False Then Open Speicherpfad & Dateiname For Output As #1 Print #1, "Link: " & Trim(rng.Offset(0, 22)) Print #1, "Username: " & Trim(rng.Offset(0, 20)) Print #1, "Passwort: " & Trim(rng.Offset(0, 21)) Close #1
Anzahl = Anzahl + 1
If Mem = "" Then Mem = "Zeile. " & Format(rng.Row, "000") & " = " & Speicherpfad & Dateiname Else Mem = Mem & Chr(10) & "Zeile. " & Format(rng.Row, "000") & " = " & Speicherpfad & Dateiname End If End If End If Next rng End With
MsgBox "Es wurden " & Format(Anzahl, "000") & " Textdateien erstellt" & Chr(10) & Chr(10) & Mem End Sub
Function Datei_vorhanden(Dateipfad As String) As Boolean If Dir(Dateipfad) <> "" Then Datei_vorhanden = True Else Datei_vorhanden = False End If End Function
Public Sub Passwortordner_öffnen() Shell "Explorer.exe " & Speicherpfad, vbNormalFocus End Sub
Titel: Antw: Office 2016 Textdateien automatisch generieren aus Exceldateien - Fehler in bestehendem VB
Beitrag von: maninweb am Februar 25, 2018, 10:04:03 Vormittag
Hallo,
tausche mal die betroffene Zeile durch folgende aus. Ändert sich das Verhalten? Wenn Nein (was ggf. zu erwarten ist), dann liegt das Problem woanders, was ich ohne Beispieldaten nicht nachvollziehen kann.
Titel: Antw: Office 2016 Textdateien automatisch generieren aus Exceldateien - Fehler in bestehendem VB
Beitrag von: inane am Februar 25, 2018, 16:37:13 Nachmittag
Hallo,
danke für den Tipp, dies hat zwar nichts geändert aber ich habe nun den Fehler selbst gefunden...
die Werte welche in die Textdatei übernommen werden, werden mittels eines Sverweises ausgelesen, da in einer Zeile jedoch in der Quellzelle keine Daten enthalten waren (unabsichtlich gelöscht), war die Ziel-Zelle mit #WERT befüllt.
Dadurch wurde der Fehler wie oben angegeben verursacht. Quellzelle wieder befüllt, Script ausgeführt, funktioniert ;-)