Datei bearbeiten und löschen
#1
Hallo,

ich lese eine .asc Datei in Excel ein und lasse ein Makro aus einer anderen Datei darüber laufen um die ASC etwas anzupassen.
Zum Schluss wird die ASC dann unter einem anderen Namen abgespeichert.

Wie kann ich jetzt erreichen, das die Ursprüngliche datei gelöscht wird. Geht das überhaupt wenn das keine richtige Exceldatei ist?


Hier mal der Code:  (evtl könnte den ja auch wer etwas optimieren)

Code:
Sub DFÜumwandeln()
'
'
'
If Mid(Range("A1"), 223, 5) = "520  " Then
End If

If Mid(Range("A1"), 223, 5) = "31010" Then

Range("A1").Select
   ActiveCell.Replace What:="BMW-AG", Replacement:=" 10300", LookAt:=xlPart _
       , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False
   Cells.Replace What:="BMW-AG", Replacement:=" 10300", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False
       
       End If
If Mid(Range("A1"), 223, 5) = "69 53" Then

Range("A1").Select
   ActiveCell.Replace What:="BMW AG", Replacement:=" 10367", LookAt:=xlPart _
       , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False
   Cells.Replace What:="BMW AG", Replacement:=" 10300", LookAt:=xlPart, _
       SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
       ReplaceFormat:=False
       
       End If
       
 
 Dim tFolder As String
 
 On Error Resume Next
 'Verzeichnis anlegen falls nicht vorhanden
 tFolder = "Z:\ecosio\fetch\"
 If Dir(tFolder) = "" Then MkDir tFolder
 
 
 ActiveWorkbook.SaveCopyAs tFolder & "KBMW" & Mid(Range("A1"), 167, 7) & ".Asc"

  ActiveWorkbook.Close savechanges:=False
       
       
End Sub
Top
#2
Hallo Mario,

du kannst eine Datei löschen mit
Code:
Kill "C:\Ordner\Datei.asc"

Oder du benennst die bestehende Datei einfach gleich um
Code:
Name "C:\Ordner\Datei.asc" As "C:\Ordner\DateiNeu.asc"
Schöne Grüße
Berni
Top
#3
Hallo, danke für die Antwort.
 Das Problem ist, die Ursprünglichen Dateien haben immer andere zufällige Namen. z.B. K0fe9dd47-8afc-45c3-8ccb-692daa971a17.asc
Top
#4
Nun, dann musst du dir den Dateinamen der importierten Datei eben als Variable verfügbar machen.
Schöne Grüße
Berni
Top
#5
Hallo Michael,

der Code kann tatsächlich verbessert werden. Versuche es aber mal so

Code:
Sub DFÜumwandeln()
'
'
'
   Dim tFolder As String
   Dim strDateiname As String
  
   'was soll das für eine If sein?
   If Mid(Range("A1"), 223, 5) = "520  " Then
   End If
  
   If Mid(Range("A1"), 223, 5) = "31010" Then
  
      Range("A1").Replace What:="BMW-AG", Replacement:=" 10300", LookAt:=xlPart _
      , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
      ReplaceFormat:=False
      Cells.Replace What:="BMW-AG", Replacement:=" 10300", LookAt:=xlPart, _
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
      ReplaceFormat:=False
  
   End If
   If Mid(Range("A1"), 223, 5) = "69 53" Then
  
      Range("A1").Replace What:="BMW AG", Replacement:=" 10367", LookAt:=xlPart _
      , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
      ReplaceFormat:=False
      Cells.Replace What:="BMW AG", Replacement:=" 10300", LookAt:=xlPart, _
      SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
      ReplaceFormat:=False
  
   End If
  
   strDateiname = ActiveWorkbook.FullName
  
   On Error Resume Next
   'Verzeichnis anlegen falls nicht vorhanden
   tFolder = "Z:\ecosio\fetch\"
   If Dir(tFolder) = "" Then MkDir tFolder
  
  
   ActiveWorkbook.SaveCopyAs tFolder & "KBMW" & Mid(Range("A1"), 167, 7) & ".Asc"
  
   ActiveWorkbook.Close savechanges:=False
   Kill strDateiname
  
End Sub
Gruß Stefan
Win 10 / Office 2016
Top
#6
Hallo,

werd das mal testen.

Die erste If, die ist dafür, da sind auch Dateien eines anderen Kunden dabei. Evtl. muss ich für die auch noch etwas einbauen. Aber stimmt, momentan ist das nicht erforderlich.
Top
#7
Passt soweit, danke.

Aber noch eine Frage. Das mit dem ersetzen ist mit dem Rekorder aufgenommen, warum ist das doppelt? Muss das so sein?
Code:
 Range("A1").Replace What:="BMW-AG", Replacement:=" 10300", LookAt:=xlPart _
     , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
     ReplaceFormat:=False
     Cells.Replace What:="BMW-AG", Replacement:=" 10300", LookAt:=xlPart, _
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
     ReplaceFormat:=False

Und wie aufwendig vom Code her wäre es, wenn ich in einer Datei das Makro starte, und es arbeitet im Hintergrund alle vorhandenen Daten in dem Ordner ab. Also öffnen, Zahl suchen, Baustein ersetzen, Kopie speichern, alte Datei löschen.
Aber dafür müßte ich dann mit 2 Ordnern arbeiten oder? Sonst würde das doch inner Endlosschleife arbeiten?
Top
#8
Hallo Mario,

du legst doch einen zweiten Ordner schon an

Code:
Sub DFÜumwandeln()
'
'
'
   Dim tFolder As String
   Dim strDateiname As String
  
   tFolder = "Z:\ecosio\fetch\"
   If Dir(tFolder) = "" Then MkDir tFolder
  
   'Ordnername an drei Stellen anpassen!!!!!!! Ich habe hier Thisworkbook.path verwendet
   strDateiname = Dir(ThisWorkbook.Path & "\*.Asc")
   Do While strDateiname <> ""
      Workbooks.Open ThisWorkbook.Path & "\" & strDateiname
      With ActiveWorkbook.Worksheets(1)
         If Mid(.Range("A1"), 223, 5) = "31010" Then
        
            .Range("A1").Replace What:="BMW-AG", Replacement:=" 10300", LookAt:=xlPart _
            , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        
         End If
         If Mid(.Range("A1"), 223, 5) = "69 53" Then
        
            .Range("A1").Replace What:="BMW AG", Replacement:=" 10367", LookAt:=xlPart _
            , SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        
         End If
        
         ActiveWorkbook.SaveCopyAs tFolder & "KBMW" & Mid(.Range("A1"), 167, 7) & ".Asc"
        
         ActiveWorkbook.Close savechanges:=False
         Kill ThisWorkbook.Path & "\" & strDateiname
      End With
      strDateiname = Dir()
   Loop
End Sub
Gruß Stefan
Win 10 / Office 2016
Top
#9
Hallo Stefan,

der Ordner existiert schon, muss auch, da der mit nem OFTP2 Server syncronisiert ist, und unser ERP-System von dort die daten einliest. Das Codestück ist aus nem andern Makro aber ich habs drin gelassen falls der Ordner mal aus versehen gelöscht ist oder so. 

Ich werd dein Code mal mit extra angelegten Ordnern testen.

Verstehe ich deinen jetzt richtig? 
 Die Quelldateien müssten in einen neu anzulegenden Ordner( ThisWorkbook.path)

Aber die bearbeiteten Zieldateien packt der Code in den jetzigen?
Top
#10
Hallo Mario,

(24.10.2018, 12:55)M.Wichmann schrieb: Verstehe ich deinen jetzt richtig? 
 Die Quelldateien müssten in einen neu anzulegenden Ordner( ThisWorkbook.path)

nein, da muss nichts angelegt werden sondern du musst nur den Namen anpassen. Da Du ja den Ordnernamen nicht genannt hast, habe ich halt den her genommen, indem die Datei mit dem Makro ist, und das wird dir mit Workbokk.Path zurückgegeben.
Gruß Stefan
Win 10 / Office 2016
Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 2 Gast/Gäste