08.08.2016, 14:45
Hallo zusammen,
ich habe folgenden VBA-Code geschrieben. Die Arbeitsmappe ist frei gegeben, da mehrere Kollegen damit arbeiten.
Wenn ich Exclusivrechte habe, funktioniert das Makro einwandfrei. Sobal ich es frei gegeben habe, kommt der Laufzeitfehler '1004' - die unprotect-Methode funktioniert nicht.
Private Sub CommandButton3_Click()
ActiveSheet.Unprotect
Selection.AutoFilter
Range("A11:AC1500").Select
Selection.AutoFilter
ActiveSheet.Range("$A$11:$AC$1500").AutoFilter Field:=2, Criteria1:=Array( _
"-", "offen", "vor Beginn", "ZF Ende", "Ende ZF", "="), Operator:=xlFilterValues
Dim MyMessage As Object, MyOutApp As Object
Dim SavePath As String
Dim AWS As String
AWS = "O:\Prj\BLB\S\StructKurt\Masterlisten\Masterliste.pdf"
'InitializeOutlook = True
Set MyOutApp = CreateObject("Outlook.Application")
'Nachrichtenobject erstellen
Sheets("Masterliste").ExportAsFixedFormat Type:=xlTypePDF, Filename:="O:\Prj\Masterliste.pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = "xyz"
.Subject = "Masterliste 5950" & " " & Date & " " & Time
'Hier wird die temporär gespeicherte Datei als
'Attachment zugefügt
.attachments.Add AWS
'Hier wird eine normale Text Mail erstellt
'Hier wird die HTML Mail erstellt
.HTMLBody = "Hallo zusammen," & _
"
" & _
"anbei die tägliche Masterliste." & _
"
" & _
"Gruß" & _
"
" & _
"Team 5950"
'Hier wird die Mail nochmals angezeigt
.display
'Hier wird die Mail gleich in den Postausgang gelegt
'.Send
'Hier wird die temporäre Datei wieder gelöscht
Kill AWS
Selection.AutoFilter
Range("A11:AC1500").Select
Selection.AutoFilter
ActiveWorkbook.SaveCopyAs "O:\Prj\Masterlisten\ " & ActiveSheet.Name & "_" & Format(Now, "yymmdd_hhmm") & ".xlsm"
Range("F12:F1500").Copy
Range("G12").PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
ActiveSheet.Range("$A$11:$AC$1500").AutoFilter Field:=2, Criteria1:=Array( _
"-", "offen", "vor Beginn", "ZF Ende", "Ende ZF", "="), Operator:=xlFilterValues
Range("D1").Select
End With
Kann mir da jemand helfen, warum dieser Fehler kommt?
VG und Danke vorab
Stefan
ich habe folgenden VBA-Code geschrieben. Die Arbeitsmappe ist frei gegeben, da mehrere Kollegen damit arbeiten.
Wenn ich Exclusivrechte habe, funktioniert das Makro einwandfrei. Sobal ich es frei gegeben habe, kommt der Laufzeitfehler '1004' - die unprotect-Methode funktioniert nicht.
Private Sub CommandButton3_Click()
ActiveSheet.Unprotect
Selection.AutoFilter
Range("A11:AC1500").Select
Selection.AutoFilter
ActiveSheet.Range("$A$11:$AC$1500").AutoFilter Field:=2, Criteria1:=Array( _
"-", "offen", "vor Beginn", "ZF Ende", "Ende ZF", "="), Operator:=xlFilterValues
Dim MyMessage As Object, MyOutApp As Object
Dim SavePath As String
Dim AWS As String
AWS = "O:\Prj\BLB\S\StructKurt\Masterlisten\Masterliste.pdf"
'InitializeOutlook = True
Set MyOutApp = CreateObject("Outlook.Application")
'Nachrichtenobject erstellen
Sheets("Masterliste").ExportAsFixedFormat Type:=xlTypePDF, Filename:="O:\Prj\Masterliste.pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
.To = "xyz"
.Subject = "Masterliste 5950" & " " & Date & " " & Time
'Hier wird die temporär gespeicherte Datei als
'Attachment zugefügt
.attachments.Add AWS
'Hier wird eine normale Text Mail erstellt
'Hier wird die HTML Mail erstellt
.HTMLBody = "Hallo zusammen," & _
"
" & _
"anbei die tägliche Masterliste." & _
"
" & _
"Gruß" & _
"
" & _
"Team 5950"
'Hier wird die Mail nochmals angezeigt
.display
'Hier wird die Mail gleich in den Postausgang gelegt
'.Send
'Hier wird die temporäre Datei wieder gelöscht
Kill AWS
Selection.AutoFilter
Range("A11:AC1500").Select
Selection.AutoFilter
ActiveWorkbook.SaveCopyAs "O:\Prj\Masterlisten\ " & ActiveSheet.Name & "_" & Format(Now, "yymmdd_hhmm") & ".xlsm"
Range("F12:F1500").Copy
Range("G12").PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
ActiveSheet.Range("$A$11:$AC$1500").AutoFilter Field:=2, Criteria1:=Array( _
"-", "offen", "vor Beginn", "ZF Ende", "Ende ZF", "="), Operator:=xlFilterValues
Range("D1").Select
End With
Kann mir da jemand helfen, warum dieser Fehler kommt?
VG und Danke vorab
Stefan