Prüfung "Datei bereits vorhanden" einbauen
Sandra
schon wieder ich.
Ich brauche Eure Hilfe bei der Ergänzung eines Makros. Derzeit sieht mein Makro so aus:
Sub PDF_Print_Sheet()
'Modifiziert
Dim wks As Worksheet
For Each wks In ActiveWindow.SelectedSheets
With wks
.Select
.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Environ("userprofile") & "\Desktop\" & .Name & ".pdf", Quality:=xlQualityStandard, _
_
_
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End With
Next wks
End Sub
Im Moment bekomme ich nämlich eine Fehlermeldung, wenn ich das Makro ausführe und eine Datei mit gleichem Namen bereits vorhanden ist.
Hier ist diese "Funktion" (DANKE TINO!!) mit eingebaut:
Sub Makro1()
Dim oWB As Workbook
Dim oSh As Worksheet
Dim objShell As Object
Dim Desktop As String
Dim strPDF_Name As String
strPDF_Name = InputBox("Geben sie den Namen der Pdf Datei an", "Name vergeben")
If strPDF_Name = "" Then Exit Sub
strPDF_Name = IIf(Right$(LCase(strPDF_Name), 4) = ".pdf", strPDF_Name, strPDF_Name & ".pdf")
Set objShell = CreateObject("WScript.Shell")
Desktop = objShell.SpecialFolders("Desktop")
Desktop = IIf(Right$(Desktop, 1) = "\", Desktop, Desktop & "\")
If Dir(Desktop & strPDF_Name) "" Then
If MsgBox("Datei mit den Namen " & strPDF_Name & " schon vorhanden!" & vbCr & _
"Wollen Sie diese ersetzen?", vbYesNo) = vbNo Then
Exit Sub
End If
End If
Application.ScreenUpdating = False
ActiveWindow.SelectedSheets.Copy
Set oWB = ActiveWorkbook
For Each oSh In oWB.Worksheets
oSh.PageSetup.RightFooter = "Seite &P von &N"
Next oSh
oWB.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Desktop & "Name.pdf", Quality:=xlQualityStandard, IncludeDocProperties:= _
True, IgnorePrintAreas:=False, OpenAfterPublish:=False
oWB.Close False
Application.ScreenUpdating = True
End Sub
Könnt Ihr mir dabei helfen?
Lieben Dank
Sandra