Makro Probleme beim ausführen
12.02.2021 15:42:25
Ralf
vorab, ich weiß wir sind hier im Excel Forum nur niemand kann mir bisher helfen und Makro in Excel oder Word sind doch bestimmt fast identisch, daher meine riesen Bitte um Hilfe, denn ich habe 4 Dokumente jeweils 430 Ausdrucke, bitte nicht manuell.
Mein Problem bezieht sich auf eine Makro, die ein Dokument in einzelne pdf-Doku speichern soll.
Ich habe 4 verschiedene Dokumente, eine Makro und diese nur kopiert und den Speichernamen verändert.
Die kopierte Makro aus dem Netz war so geschrieben, das ein Ordner auf dem Desktop angelegt wird und dort alles abgelegt werden soll. Dies wollte ich nicht und habe den Speicherort verändert.
Nun führe ich die Marko aus und ich werde trotzdem gefragt, wo gespeichert werden soll. Wie kann ich das abstellen?
Dann werden 6 Dokumente abgespeichert als pdf, dann bekomme ich die Fehlermeldung: Der ausgewählte Speicherort ist ungültig. (Modul 3)
Beim Modul 1 wird der Ordner angelegt, nichts wird gespeichert, der Ordner beleibt leer und die Fehlermeldung lautet. Unbekannter Fehler 5941.
Recherche im Netz hat ergeben, das es wohl Unterschiede gibt bei der Word Version, ich benutze Office 365.
Bitte helft mir, vielen Dank, Ihr spart mir Stunden..
Lieben Gruß und Danke vorab.
Ralf B.
(Modul 3)
Sub Gestattungsvertrag_im_PDF_Format_speichern()
' set variables
Dim iBrief As Integer, sBrief As String
Dim AppShell As Object
Dim BrowseDir As Variant
Dim Path As String
' catch any errors
On Error GoTo ErrorHandling
' determine path
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "C:\Desktop\", 0, 16)
If BrowseDir = "C:\Desktop\" Then
Path = CreateObject("WScript.Shell").SpecialFolders("C:\Desktop\")
Else
Path = BrowseDir.items().Item().Path
End If
If Path = "" Then GoTo ErrorHandling
Path = Path & "\Gestattungsvertrag-" & Format(Now, "dd.mm.yyyy-hh.mm.ss") & "\"
MkDir Path
On Error GoTo ErrorHandling
' hide application for better performance
MsgBox "Serienbriefe werden exportiert. Dieser Vorganag kann einige Minuten dauern - _
Microsoft Word wird während dieser Zeit ausgeblendet", vbOKOnly + vbInformation
Application.Visible = False
' create bulkletter and export as pdf
With ActiveDocument.MailMerge
.DataSource.ActiveRecord = 1
Do
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = .ActiveRecord
.LastRecord = .ActiveRecord
sBrief = Path & .DataFields("VorNachname_GV").Value & ".pdf"
End With
.Execute Pause:=False
If .DataSource.DataFields("VorNachname_GV").Value > "" Then
ActiveDocument.SaveAs FileName:=sBrief, FileFormat:=wdFormatPDF
End If
ActiveDocument.Close False
If .DataSource.ActiveRecord 0 Then
MsgBox "Unbekannter Fehler: " & Err.Number & " - Bitte Makro erneut ausführen.", _
vbOKOnly + vbCritical
Else
MsgBox "Serienbriefe erfolgreich exportiert", vbOKOnly + vbInformation
End If
End Sub
Sub Erstes_Anschreiben_im_PDF_Format_speichern()
' set variables
Dim iBrief As Integer, sBrief As String
Dim AppShell As Object
Dim BrowseDir As Variant
Dim Path As String
' catch any errors
On Error GoTo ErrorHandling
' determine path
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "C:\Users\Ralf.Bredenbeck\Documents\1_Druck\", _
0, 16)
If BrowseDir = "C:\Users\Ralf.Bredenbeck\Documents\" Then
Path = CreateObject("WScript.Shell").SpecialFolders("C:\Users\Ralf.Bredenbeck\Documents\ _
1_Druck\")
Else
Path = BrowseDir.items().Item().Path
End If
If Path = "" Then GoTo ErrorHandling
Path = Path & "\Erstes Anschreiben-" & Format(Now, "dd.mm.yyyy-hh.mm.ss") & "\"
MkDir Path
On Error GoTo ErrorHandling
' hide application for better performance
MsgBox "Serienbriefe werden exportiert. Dieser Vorganag kann einige Minuten dauern - _
Microsoft Word wird während dieser Zeit ausgeblendet", vbOKOnly + vbInformation
Application.Visible = False
' create bulkletter and export as pdf
With ActiveDocument.MailMerge
.DataSource.ActiveRecord = 1
Do
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = .ActiveRecord
.LastRecord = .ActiveRecord
sBrief = Path & .DataFields("VorNachname_1.AS").Value & ".pdf"
End With
.Execute Pause:=False
If .DataSource.DataFields("VorNachname_1.AS").Value > "" Then
ActiveDocument.SaveAs FileName:=sBrief, FileFormat:=wdFormatPDF
End If
ActiveDocument.Close False
If .DataSource.ActiveRecord 0 Then
MsgBox "Unbekannter Fehler: " & Err.Number & " - Bitte Makro erneut ausführen.", _
vbOKOnly + vbCritical
Else
MsgBox "Serienbriefe erfolgreich exportiert", vbOKOnly + vbInformation
End If
End Sub