bluesonic_666
Grünschnabel
Hallo,
ich möchte gern meine Excel-Datei über ein VBA-Script speichern, das funktioniert auch soweit, allerdings wenn ich die Datei dann nochmals (über excel selbst) speichern will bringt er immer die Meldung (Siehe Anhang)
Wie bekomm ich das hin, das diese Meldun nicht meh kommt...
Das Programm was ich habe, liest eine Textdatei ein, zerlegt alles in Spalten, und entfernt unnötigen Inhalt und soll dann alles al Excel speichern...
Danke im voraus
ich möchte gern meine Excel-Datei über ein VBA-Script speichern, das funktioniert auch soweit, allerdings wenn ich die Datei dann nochmals (über excel selbst) speichern will bringt er immer die Meldung (Siehe Anhang)
Wie bekomm ich das hin, das diese Meldun nicht meh kommt...
Das Programm was ich habe, liest eine Textdatei ein, zerlegt alles in Spalten, und entfernt unnötigen Inhalt und soll dann alles al Excel speichern...
Code:
Dim Zaehler$ 'Variable um die Endlosschleife beim entfernen von Spalten zu verhindern
Dim EinDat 'variante Variable für den Pfadnamen der Eingangsvariablen
Dim Ausdat 'variante Variable für den Pfadnamen der Ausgabedatei
Dim Permitted$ 'Variable um festzustellen wie weit noch gelöscht werden muss
'###############Hier beginnt das Hauptprogramm###########################
Sub Datei_Konvertieren()
'Holen des Pfades für die Eingabe Datei
EinDat = Application.GetOpenFilename()
'Prüfen ob der ausgewählte Dateiname gültig ist
If EinDat <> False Then
' ############Einlesen der Datei############################################
' Auftrennen der Zeichenkette in die einzelnen Spalten, Trenner sind Leerzeichen, Tab und /
Workbooks.OpenText Filename:=EinDat _
, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False _
, Comma:=False, Space:=True, Other:=True, OtherChar:="/", FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7 _
, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array _
(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), _
Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1)), _
TrailingMinusNumbers:=True
Else
'Wenn Abbrechen oder das X gewählt wird, erscheint eine Meldung und das Prog wird beendet
MsgBox ("Keine Datei ausgewählt! Programm wird abgebrochen")
Exit Sub
End If
'#########################Löschen aller Spalten bis "permitted"#################
Permitted$ = False
Zaehler$ = 0
' Laufe solang wie Permitted false ist
Do While Permitted = False
' Wenn in der Zelle A1 Permittet steht dann setze permitted auf true
If Range("A1").Value = "permitted" Then
Permitted$ = True
End If
Columns("A:A").Delete 'Löschen der Spalte A
Zaehler$ = Zaehler$ + 1 'Hochzählen des Zählers
'Für den Fall das es kein Permitted gibt wird nach 1000 Spalten abgebrochen
If Zeile > 1000 Then
Exit Sub
End If
Loop
' In Spalte jetzt das Protokoll ---> FIX
' Löschen der Spalte B
Columns("B:B").Delete
' In Spalte B Steht jetzt der Host (unbearbeitet) ----> FIX
' Löschen der spalten C und D
Columns("C:D").Delete
' In Spalte C Steht jetzt der Zielhost (unbearbeitet) ---> FIX
' Löschen der restlichen Spalten
Columns("D:I").Delete
' Einfügen einer Spalte vor C und verschieben nach rechts
Columns("C").Insert Shift:=xlToRight
' Auswählen der Spalte B
Columns("B").Select
' Auftrennen der Spalte B der, Wert in der Klammer(Host-Port) kommt in Spalte C
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="(", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
' Löschen der Spalte C
Columns("C").Delete
' Auswählen der Spalte C
Columns("C").Select
' Auftrennen der Spalte D, der Wert in der Klammer(Zielhost-Port) kommt in Spalte D
Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="(", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
' Auswählen der Spalte D
Columns("D").Select
' Entfernen der Schließenden Klammer
Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=")", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
'Ausfiltern der Duplikate
Range("A:D").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns _
("E:H"), Unique:=True
' Löschen der Spalte A bis D
Columns("A:D").Delete
' Spalte A Auswählen
Columns("A").Select
' Eine Zeile für die Überschriften einfügen
Rows(1).Insert Shift:=xlDown
' Überschriften der Spalten eintragen
Range("A1").Value = "Protokoll"
Range("B1").Value = "Host"
Range("C1").Value = "Zielhost"
Range("D1").Value = "Port"
' Spalten A bis D auswählen
Columns("A:D").Select
' Optimale Breite einstellen für die 4 Spalten
Range(Selection, Selection.End(xlToRight)).Select
Cells.EntireColumn.AutoFit
' Ausgabedatei auswählen im SpeichernUnter Dialog
Ausdat = Application.GetSaveAsFilename(InitialFileName:=Environ("USERPROFILE") & "\Desktop\" & _
".xls", FileFilter:="Microsoft Excel-Arbeitsmappe (*.xls), *.xls")
' Speichern wenn eine Datei eingegeben wurde
If Ausdat = ".xls" Then
MsgBox ("Noch Keine Datei ausgewählt! Datei nicht gespeichert")
ElseIf Ausdat <> False Then
ActiveWorkbook.SaveAs Ausdat
Else
'Wenn keine Datei angegeben wurde muss diese noch gespeichert werden---> Meldung
MsgBox ("Noch Keine Datei ausgewählt! Datei nicht gespeichert")
Exit Sub
End If
End SubDanke im voraus
