Objektvariable oder With-Blockvariable nicht festg
26.11.2018 17:58:33
Knight
ich habe mal eine Frage bzgl. eines Fehlers, was mir der VBA Editor wirft. Die dazugehörigen Excel-Datei habe ich mit angefügt. Das Passwort zum öffnen der Datei ist "qwe123". Hier zu finden https://www.herber.de/bbs/user/125661.xlsm
Das makro soll folgendes tun:
- Eine mail soll generiert werden
- In der Mail soll eine Tabelle erstellt mit folgenden Headern:
"Datum" - "ESK" - ESK backup"
- Bei ESK soll aus der dem worksheet "Schichtplanung-Neu" die Tage, in denen "ESK" oder "Normal+NB" steht ausgefüllt werden.
Bei ESK backup alle Tage mit dem ESKB im Feld.
Unten soll eine Tabelle mit den Namen des Mitarbeiters, seine Telefonnummer und email adresse abgebildet werden. Diese Information wird aus dem Worksheet Telefonliste bezogen.
Ein screenshot wie es aussehen soll, kann hier gefunden werden https://www.herber.de/bbs/user/125662.jpg
Mein Code sieht folgendermaßen aus:
Sub CreateMail()
'password handling
Dim password As Variant
password = Application.InputBox("Enter Password", "Password Protected")
Select Case password
Case Is = False
'do nothing, no password is set
Case Is "email"
'wrong password
MsgBox "Passwort nicht korrekt."
Case Else
'execute the makro
executeMail
End Select
End Sub Sub executeMail()
'On Error Resume Next
Dim olApp As Object
Set olApp = CreateObject("Outlook.Application")
Set NewMail = olApp.CreateItem(olMailItem)
'declare variables for rowNumbers, weekNumber ans shiftUser
Dim weekNum As Long, searchDateColumnNum As Long, calculator As Long
Dim shiftRowNum As Long, additionalShiftRowNum As Long, lateNightShiftRowNum As Long, earlyNightShiftRowNum As Long
Dim shiftUser As String, lateNightShiftUser As String, earlyNightShiftUser As String, additionalShiftUser As String
Dim dayDate As Date, startDate As Date, endDate As Date
dayDate = Date
'get user input for number of days
customerRequest:
dayCount = Application.InputBox("Enter the number of days to evaluate", "Day Count", 8)
If dayCount = False Then GoTo cancelButton
Select Case dayCount
Case 1 To 15
'correct number, no need for a new number
Case Else
'execute the makro
MsgBox "Please enter a number between 1 and 15"
GoTo customerRequest 'go back to customer questions for the number of days
End Select
'Date evaluation and weekdays
Dim currentDate As Date
currentDate = Date
weekStartDate = DateAdd("d", -Weekday(currentDate) + 2, currentDate) '+2 offset weekstart sunday and current day
weekEndDate = DateAdd("d", dayCount - 1, weekStartDate)
searchDate = weekStartDate
weekDays = Array("Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag", "Samstag", "Sonntag", "Montag", "Dienstag", "Mittwoch", "Donnerstag", "Freitag", "Samstag", "Sonntag", "Montag")
dayDate = weekStartDate
'Define and set Worksheet dimension
Dim ShiftSheet As Worksheet, phoneSheet As Worksheet
Set ShiftSheet = Worksheets("Schichtplanung-Neu")
Set phoneSheet = Worksheets("Telefonliste")
'strings for normal output and strings for table and its styles
TableStyle = "style=""border: 1px solid black; padding: 5px;"""
tableHeaderTagStart = "
tableHeaderTagEnd = "
tableCellTagStart = "
tableCellTagEnd = "
linebreak = "
"
Dim nightShiftArray() As String
ReDim nightShiftArray(dayCount, 2) As String
Dim searchStrings(4) As String
searchStrings(0) = "ESK"
searchStrings(1) = "ESK b"
searchStrings(2) = "Normal+NB"
searchDateColumnNum = ShiftSheet.Rows(5).Find(what:=Format(searchDate, "DD.MM.YYYY"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
Dim emptyRow As Boolean
emptyRow = False
Dim counter As Long
counter = 0
'phoneList for phone numbers
phoneString = "
'Mail content Table Output
strhtml = "
Hallo zusammen," & "
" & "
"
strhtml = strhtml & "Bereitschaftsabdeckung vom " & Format(weekStartDate, "DD.MM.YYYY") & " bis " & Format(weekEndDate, "DD.MM.YYYY") & ".
"
strhtml = strhtml & "Hinweis: Die Bereitschaftsabdeckung gilt immer von 06:00 Uhr bis 06:00 Uhr des jeweiligen Tages." & "
strhtml = strhtml & "
" & "
"
'Generate mail with subject, receiver and set content
With NewMail
.Getinspector
.Importance = 2
.Subject = "[BEREITSCHAFTSABDECKUNG]von " & Format(weekStartDate, "DD.MM.YYYY") & " bis " & Format(weekEndDate, "DD.MM.YYYY") & " "
.To = "test@mail.com"
.HTMLbody = strhtml & phoneString & .HTMLbody
.display
End With
cancelButton:
'do nothing
End Sub
Private Function findPhoneNumber(phoneList, employeeName, phoneSheet) As String
Dim FoundRow As Range
Dim FindRowNumber As Long
findPhoneNumber = " "
With phoneSheet
Set FoundRow = .Range("A:A").Find(what:=employeeName, LookIn:=xlValues)
FindRowNumber = FoundRow.Row
findPhoneNumber = findPhoneNumber & FoundRow & " " & .Cells(FindRowNumber, 2).Value & " " & .Cells(FindRowNumber, 3).Value & " "
End With
End Function
Der Debugger meldet beim Ausführen "Objektvariable oder With-Blockvariable nicht festgelegt" und markiert den folgenden Code-Snippet:
searchDateColumnNum = ShiftSheet.Rows(5).Find(what:=Format(searchDate, "DD.MM.YYYY"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
Könntet ihr mir vielleicht hier weiterhelfen?