Speichern ohne Makros
28.10.2008 18:24:09
Paul
Ich möchte, dass die Datei die hier unter E:\LB gespeichert wird, keine Makros enthält.
Alle diesbezüglichen Einträge im Forum konnte ich bisher nicht umsetzen daher jetzt hier das gesamte Makro mit der Bitte, die Speicherprozedur anzupassen!
Sub Lackbericht()
Dim OApp As Object, OMail As Object
Dim strAtt As String
Dim attAdd As Boolean
Dim n As String, n1 As String
n = Range("F8").Value
n1 = Range("H8").Value
n2 = Range("G53").Value
Range("i53").Select
ActiveCell.FormulaR1C1 = "=NOW()"
ActiveSheet.SaveAs Filename:="E:\LB\" & "LB-" & n & "-" & n1 & "-" & n2 & ".xls" '
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("a7").Select
Dim var
var = [h8]
On Error GoTo ErrExit
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OApp = CreateObject("Outlook.Application")
OApp.Session.Logon
Set OMail = OApp.CreateItem(0)
With OMail
.To = "tt.ttt.de" 'Empfänger
.Subject = "LB-" & ActiveSheet.Range("f8").Value & "-" & ActiveSheet.Range("h8").Value
.Attachments.Add ActiveWorkbook.FullName
Do
strAtt = Application.GetOpenFilename("Alle Dateien (*.*),*.*")
If strAtt "Falsch" Then
.Attachments.Add strAtt
attAdd = True
End If
If Not attAdd Then
If MsgBox("Wollen Sie die Datei wirklich ohne weitere Anlagen versenden?", _
36, "Mailanhang") = 7 Then strAtt = ""
End If
Loop While strAtt "Falsch"
.Display 'oder .Send um die Mail gleich zu versenden
End With
ErrExit:
Set OMail = Nothing
Set OApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub