Anzeige
Archiv - Navigation
1608to1612
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Code für prüfen ob Datei bereits vorhanden ist

Code für prüfen ob Datei bereits vorhanden ist
15.02.2018 15:54:54
Andreas
Hallo,
hab da eine Frage
und zwar wie man ein Prüfung einfügt ob die Datei die es zu speichern gilt, im Zielordner schon vorhanden ist.
Am besten natürlich über eine msgBox.
Wenn die Datei schon existiert soll diese aber nicht überschrieben werden können, sondern soll über eine nächste Box umbenannt werden können.
Hab euch meinen bisherigen Code kopiert.
Hoffe mir kann jemand helfen.
Vielen Dank im voraus
LG Andi
Sub Seite1_speichern()
' Seite1_speichern Makro
If MsgBox("Wollen sie die aktuelle Kalenderwoche wirklich übermitteln?", vbYesNo + vbQuestion, " _
Achtung") = vbYes Then
' speichert Tabelle unter Pfad und vorgegebenen Namen als pdf
ChDir "D:\Daten\Test"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"D:\Daten\Test\" & Range("D5") & "_KW" & Range("AQ2") & "_" & Range("G5"), Quality:= _
xlQualityStandard, IncludeDocProperties:= _
True, IgnorePrintAreas:=False, From:=1, To:=3, OpenAfterPublish:=True
' Erzeugt einen Übermittelt Stempel
ActiveSheet.Unprotect Password:="Alina1711"
Range("J33:O34").Select
ActiveCell.FormulaR1C1 = "Übermittelt"
Range("J33:O34").Select
With Selection.Interior
.Pattern = xlGray25
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("B25").Select
ActiveSheet.Protect Password:="Alina1711"
End If
End Sub

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Code für prüfen ob Datei bereits vorhanden ist
15.02.2018 16:01:34
UweD
Hallo
ungeprüft

if DIR("DeineDateiMitKomplettemPfad")"" then
'Datei ist da
Else
'Noch neu
end if
LG UweD
AW: Code für prüfen ob Datei bereits vorhanden ist
15.02.2018 16:40:33
Andreas
Hallo UweD,
danke für deine Antwort.
Aber bin ehrlich nicht so gut in VBA.
Hab zwar deinen Code eingearbeitet aber die Dateien werden dennoch überschrieben bzw.
bekomme ich das mit den msgBoxen auch nicht hin.
Vielleicht hättest du noch einen anderen Lösungsvorschlag
AW: Code für prüfen ob Datei bereits vorhanden ist
15.02.2018 16:58:17
Peter(silie)
Hallo,
versuchs mal so:
Sub Seite1_speichern()
Dim path As String
Dim folder_ As String
fodler_ = "D:\Daten\Test\"
If MsgBox("Wollen sie die aktuelle Kalenderwoche wirklich übermitteln?", _
vbYesNo + vbQuestion, " Achtung") = vbYes Then
If Not PathExists(folder_) Then
ChDir folder_
End if
path = folder_ & Range("D5") & "_KW" & Range("AQ2") & "_" & Range("G5")
If Not PathExists(path) Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
path, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
From:=1, To:=3, OpenAfterPublish:=True
Else
MsgBox "Datei existiert bereits"
End if
' Erzeugt einen Übermittelt Stempel
ActiveSheet.Unprotect Password:="Alina1711"
Range("J33:O34").Select
ActiveCell.FormulaR1C1 = "Übermittelt"
Range("J33:O34").Select
With Selection.Interior
.Pattern = xlGray25
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("B25").Select
ActiveSheet.Protect Password:="Alina1711"
End If
End Sub
Private Function PathExists(byVal path As String) As boolean
PathExists = Dir(path, vbDirectory)  vbNullString
End Function  

Anzeige
Ups fehler
15.02.2018 16:59:44
Peter(silie)
Hallo,
Sub Seite1_speichern()
Dim path As String
Dim folder_ As String
fodler_ = "D:\Daten\Test\"
das Fettmarkierte ersetzen durch: folder_ = "D:\Daten\Test\"
AW: Ups fehler
15.02.2018 17:15:38
Andreas
Hallo Peter(silie),
danke auch für deine Antwort,
habs ausprobiert aber die Dateien werden dennoch überschrieben, bzw.
die msgBox "Datei existiert bereits" erscheint erst gar nicht.
Vielleicht noch ne Idee?
LG Andi
AW: Code für prüfen ob Datei bereits vorhanden ist
15.02.2018 17:14:08
UweD
dann versuch es mal so...

Sub Seite1_speichern()
    Dim Pfad As String, Dateiname As String, Ext As String
    
    Ext = ".pdf"
    
    Pfad = "D:\Daten\Test\"
    
    If Dir(Pfad, vbDirectory) = "" Then
    
        MsgBox "Pfad  '" & Pfad & "'  existiert nicht"
        Exit Sub
        
    End If
    
    
    
    Dateiname = Range("D5") & "_KW" & Range("AQ2") & "_" & Range("G5")
    
    
    ' Seite1_speichern Makro 
    If MsgBox("Wollen sie die aktuelle Kalenderwoche wirklich übermitteln?", vbYesNo + vbQuestion, _
        " Achtung ") = vbYes Then
        
        Do Until Dir(Pfad & Dateiname & Ext) = ""
        
            Dateiname = InputBox("Datei existiert schon", "Umbenennen in ", Dateiname)
        
        Loop
        
        ' speichert Tabelle unter Pfad und vorgegebenen Namen als pdf 
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Pfad & Dateiname & Ext, _
            Quality:=xlQualityStandard, IncludeDocProperties:= _
            True, IgnorePrintAreas:=False, From:=1, To:=3, OpenAfterPublish:=True
    
 
        ' Erzeugt einen Übermittelt Stempel 
        ActiveSheet.Unprotect Password:="Alina1711"
        With Range("J33:O34")
            .FormulaR1C1 = "Übermittelt"
            With .Interior
                .Pattern = xlGray25
                .PatternColorIndex = xlAutomatic
                .Color = 65535
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        End With
        Range("B25").Select
        ActiveSheet.Protect Password:="Alina1711"
    End If
 End Sub

LG UweD
Anzeige
AW: Code für prüfen ob Datei bereits vorhanden ist
15.02.2018 17:39:10
Andreas
Danke UweD,
genauso hab ich mir das vorgestellt, funktioniert einwandfrei!
Wär da im Leben nicht drauf gekommen. Tja, da ist noch viel zu lernen.
Auch vielen Dank an Peter(silie).
LG Andi
Danke für die Rückmeldung owT
15.02.2018 18:43:52
UweD

125 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige