Variable nicht definiert
pabro
habe mit eurer tatkräftigen Unterstützung das unten stehende Macro gechrieben:
Dieses Macro soll
1. eine Verzeichnis mit dem Namen bestehend aus den Inhalten der Zellen H8, H10 und D16 erstellen.
2. die akive Datei in diesem Verzeichnis nach einem festgelegten Muster (LB-&n, n1 und n2) abspeichern
3. das aktive Blatt kopieren und per Mail versenden
Ohne 1. hat schon alles wunderbar funktioniert, 1.alleine geht auch, nur wenn ich das ganze jetzt kombiniere (siehe unten) dann kommt (Variable nicht definiert) in der ersten strpfad-Zeile, ich finde hier leider keinen Fehler, kann mir da jemand helfen?
Option Explicit
Private Declare
Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
Sub LB_senden()
Dim strPath
Dim OApp As Object, OMail As Object
Dim strAtt As String
Dim attAdd As Boolean
Dim n As String
Dim n1 As String
Dim n2 As String
Dim n3 As String
Dim n4 As String
Dim n5 As String
Dim rngR As Range
Dim DateiZ As String
n = Range("F8").Value
n1 = Range("H8").Value
n2 = Range("G23").Value
n3 = Range("G50").Value
n4 = Range("D16").Value
n5 = Range("H10").Value
strpfad = "C:\Dokumente und Einstellungen\P.Broich\Eigene Dateien\Broich\Lackberichte\ _
Abgesendet\" & n1 & " " & n5 & " " & n4 'Hier den Pfad eingeben
If Dir(strpfad, vbDirectory) = "" Then
MkDir strpfad
Exit Sub
Else
MsgBox ("Das gewünscht Verzeichnis ist schon vorhanden, bitte einen anderen Namen eingeben!") _
_
' wenn da kommt MsgBox und springt dann zu nochmal
GoTo nochmal
End If
nochmal:
n1 = InputBox("Neuer Name")
If StrPtr(n1) = 0 Then ' Hier abbrechen der InputBox, falls doch kein neuer Name gewünscht.
Exit Sub
End If
strpfad = "C:\Dokumente und Einstellungen\P.Broich\Eigene Dateien\Broich\Lackberichte\ _
Abgesendet\" & n1 & " " & n5 & " " & n4 'Hier den Pfad eingeben
If Dir(strpfad, vbDirectory) = "" Then
On Error Resume Next
MkDir strpfad
Else
MsgBox ("schon da! Neu!")
GoTo nochmal
End If
DateiZ = "-1"
Do Until Dir("C:\Dokumente und Einstellungen\P.Broich\Eigene Dateien\Broich\Lackberichte\ _
Abgesendet\" & "LB-" & n & "-" & n1 & DateiZ & ".xls") = ""
DateiZ = Val(DateiZ) - 1
Loop
If DateiZ = "-1" Then
If Dir("C:\Dokumente und Einstellungen\P.Broich\Eigene Dateien\Broich\Lackberichte\ _
Abgesendet\" & "LB-" & n & "-" & n1 & ".xls") = "" Then DateiZ = "" Else DateiZ = "-2"
ActiveWorkbook.SaveAs Filename:="C:\Dokumente und Einstellungen\P.Broich\Eigene Dateien\ _
Broich\Lackberichte\Abgesendet\" & "LB-" & n & "-" & n1 & DateiZ & ".xls"
If DateiZ = "-2" Then Name "C:\Dokumente und Einstellungen\P.Broich\Eigene Dateien\Broich\ _
_
Lackberichte\Abgesendet\" & "LB-" & n & "-" & n1 & ".xls" As "C:\Dokumente und Einstellungen\P. _
Broich\Eigene Dateien\Broich\Lackberichte\Abgesendet\" & "LB-" & n & "-" & n1 & "-1.xls"
Else
ActiveWorkbook.SaveAs Filename:="C:\Dokumente und Einstellungen\P.Broich\Eigene Dateien\ _
_
Broich\Lackberichte\Abgesendet\" & "LB-" & n & "-" & n1 & DateiZ & ".xls"
End If
Set OApp = CreateObject("Outlook.Application")
OApp.Session.Logon
Set OMail = OApp.CreateItem(0)
With OMail
.To = "LBKOELN@FORD.COM" 'Empfänger
.Subject = "LB-" & n & "-" & n1 & "-" & n2
.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
ActiveWorkbook.Close
ErrExit:
Set OMail = Nothing
Set OApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End
Sub