Results 1 to 5 of 5
  1. #1
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,185

    Select Case without case


    Hi Guys, can anyone let me know were i am going wrong here, i get a compile error "case without select case, sorry for long code but it highlights case 4, i think that i must have had this case outside of the select case and end select ?

    Code:
    Dim MyApp As New Outlook.Application
    Dim MyItem As Outlook.MailItem
    Dim MyInput As Integer, RecNo As Integer
    Dim MailBody As String, MailTo As String, Subj As String, ClientName As String, mDriver As String, fNameDriver As String
    Dim FullName As String, fName As String, TimeNow As String, TOD As String, Product As String, DriverNo As String
    Dim NewTest As String, fSave As String, pSave As String, fOpen As String, pOpen As String
    Dim RemDate As Date
    Dim xlApp As Excel.Application
    Dim xlWB As Object
    Dim cValue As Currency, pValue As Currency, RecValue As Currency
    Dim mFOC As Variant
     
    TimeNow = Format(Now(), "hh:nn")
     
    If TimeNow <= "11:59" Then
    If TimeNow >= "00:01" Then
    TOD = "Good morning"
    End If
    End If
    If TimeNow <= "16:59" Then
    If TimeNow >= "12:01" Then
    TOD = "Good afternoon"
    End If
    End If
    If TimeNow <= "23:59" Then
    If TimeNow >= "17:01" Then
    TOD = "Good evening"
    End If
    End If
     
    RecNo = Me.RecordNo
    MailTo = Me.EMail
    ClientName = Me.Client
    RemDate = Me.Date
    Product= Me.Make
    FullName = ClientName
    fName = Left(MyString, InStr(MyString, " "))
    NewTest = "http://www.ourwebsite/new-testimonial"
     
    MyInput = InputBox("Enter What You Want To Email:" & vbNewLine & vbNewLine & _
    ClientName & " " & "?" & vbNewLine & vbNewLine & _
    " 1 = Send Booking Confirmation" & vbNewLine & vbNewLine & _
    " 2 = Send An Invoice For Product" & vbNewLine & vbNewLine & _
    " 3 = Send Receipt For Product" & vbNewLine & vbNewLine & _
    " 4 = Request A Website Testimonial", "EMAIL OPTIONS")
     
    Select Case MyInput
    Case 1
    If IsNull(DLookup("Engineer", "tblRemovals", "[RecordNo] = " & RecNo)) Then
    If MsgBox("There Is No Engineer Allocated For:" & vbNewLine & vbNewLine & _
    RemDate & " " & ClientName & vbNewLine & vbNewLine & _
    "Abort Sending Removal Confirmation Now ?", vbQuestion + vbYesNo, "NO ENGINEER ALLOCATED") = vbYes Then
    DoCmd.CancelEvent
    End If
    End If
     
    If Not IsNull(DLookup("Engineer", "tblRemovals", "[RecordNo] = " & RecNo)) Then
    mDriver = Me.Engineer
    DriverNo = DLookup("Tel", "tblDrivers", "[Driver] = '" & mDriver & "'")
    fNameDriver = Left(mDriver, InStr(mDriver, " "))
    MailBody = TOD & " " & fName & ", " & "we are writing to you to confirm your" & " " & Product & " " & "removal booking with us." & vbNewLine & vbNewLine & _
    "The date we have scheduled for you is " & Format(RemDate, "dddd-dd-mmm-yyyy") & vbNewLine & vbNewLine & _
    "The engineer allocated to remove your " & Product & " " & "is called: " & mDriver & "." & vbNewLine & vbNewLine & _
    fNameDriver & " " & "will update you on route from his appointment prior to yours" & vbNewLine & vbNewLine & _
    "If you wish to make direct contact with: " & fNameDriver & " " & "the mobile number is: " & DriverNo & vbNewLine & vbNewLine & _
    "Thank you for booking with us." & vbNewLine & vbNewLine & _
    "Please feel free to leave us your review once your " & Product & " " & "has been removed by clicking here >" & " " & NewTest
     
    Set MyItem = MyApp.CreateItem(olMailItem)
        With MyItem
           .To = MailTo
           .Body = MailBody
           .Subject = "Product removal date"
           .Display
        End With
    End If
     
    Case 3
    Forms!frmMainMenu!txtRecNoCriteria = RecNo
    If Me.TotalValue = "0" Then
    If Me.Charge = "0" Then
    mFOC = "Yes"
    Else
    mFOC = ""
    End If
    End If
    pOpen = "T:\XL Files\RECEIPTS\"
    fOpen = "RECEIPT TEMPLATE" & ".xlsx"
    pSave = "T:\XL Files\RECEIPTS\"
    fSave = "Receipt-" & " " & RecNo & ".xlsx"
     
    Set apXL = CreateObject("Excel.Application")
    Set xlWB = apXL.Workbooks.Open(pOpen & fOpen)
    apXL.ActiveWorkbook.SaveAs pSave & fSave
    apXL.Workbooks.Open pSave & fSave, True, False
    apXL.Visible = True
    With xlWB
    .Worksheets(1).Cells(2, 9) = RecNo
    .Worksheets(1).Cells(4, 9) = RemDate
    .Worksheets(1).Cells(6, 9) = mClient
    .Worksheets(1).Cells(7, 9) = Me.Add1
    .Worksheets(1).Cells(8, 9) = Me.Add2
    .Worksheets(1).Cells(9, 9) = Me.Town
    .Worksheets(1).Cells(10, 9) = Me.PostCode
    .Worksheets(1).Cells(13, 3) = Product
    .Worksheets(1).Cells(15, 9) = mClient
    .Worksheets(1).Cells(20, 9) = Me.Charge
    .Worksheets(1).Cells(22, 9) = mFOC
    .Worksheets(1).Cells(24, 9) = Me.TotalValue
    .Save
    xlWB.Close
    apXL.Quit
    Set apXL = Nothing
     
    If MsgBox("Receipt " & RecNo & " " & "Has Created Successfully" & Chr(10) & Chr(10) & _
    "Do You Want To Open It To Check Data ?", vbQuestion + vbYesNo, "FILE CREATED") = vbNo Then
    DoCmd.CancelEvent
    Else
     
    Set apXL = CreateObject("Excel.Application")
    Set xlWB = apXL.Workbooks.Open(pSave & fSave)
    apXL.Workbooks.Open pSave & fSave, True, False
    apXL.Visible = True
    DoCmd.RunCommand acCmdAppMinimize
    End If
     
    If MsgBox("Email Receipt " & RecNo & " " & "To " & mClient & " " & "Now ?", vbQuestion + vbYesNo, "EMAIL RECEIPT") = vbNo Then
    DoCmd.CancelEvent
    Else
    MailBody = TOD & " " & fName & ", " & "Thank you for choosing us to remove your product recently," & vbNewLine & vbNewLine & _
    "PLease find atttached your confirmation receipt " & "( " & "Receipt " & RecNo & " " & ") " & " " & "for the completion of the product removal located at: " & Me.PostCode & vbNewLine & vbNewLine & _
    "Here at www.ourwebsite.com, we deal with each and every client with extreme pride and would like to know your experience with our services." & vbNewLine & vbNewLine & _
    "If you are happy to share your experience with us, please feel free to help our customer services by adding your review." & vbNewLine & vbNewLine & _
    "To see what others have written about us, check our current testimonials by clicking here > http://www.ourwebsite.com/testimonials" & vbNewLine & vbNewLine & _
    "To add your own review, you can do this direct to us by clicking here >" & " " & NewTest & vbNewLine & vbNewLine & _
    "May we take this opportunity to wish you all the best" & vbNewLine & vbNewLine & _
    "From all of us at Our Website.com"
    Set MyItem = MyApp.CreateItem(olMailItem)
        With MyItem
           .To = MailTo
           .Body = MailBody
           .Attachments.Add pSave & fSave
           .Subject = "product removal receipt"
           .Display
        End With
    End If
     
    Case 4
    MailBody = TOD & " " & fName & ", " & "Thank you for choosing us to remove your product recently," & vbNewLine & vbNewLine & _
    "Here at www.ourwebsite.com, we deal with each and every client with extreme pride and would like to know your experience with our services." & vbNewLine & vbNewLine & _
    "If you are happy to share your experience with us, please feel free to help our customer services by adding your review." & vbNewLine & vbNewLine & _
    "To see what others have written about us, check our current testimonials by clicking here > http://www.ourwebsite.com/testimonials" & vbNewLine & vbNewLine & _
    "To add your own review, you can do this direct to us by clicking here >" & " " & NewTest & vbNewLine & vbNewLine & _
    "May we take this opportunity to wish you all the best" & vbNewLine & vbNewLine & _
    "From all of us at ourwebsite.com"
     
    Set MyItem = MyApp.CreateItem(olMailItem)
        With MyItem
           .To = MailTo
           .Body = MailBody
           .Subject = "product removal"
           .Display
        End With
    End Select

  2. #2
    RuralGuy's Avatar
    RuralGuy is offline Administrator
    Windows 10 Access 2013 32bit
    Join Date
    Mar 2007
    Location
    8300' in the Colorado Rocky Mountains
    Posts
    12,922
    I would start by paring up the [With xlWB...End With] statements a little tighter.

    I suspect you need a fresh [With xlWB] every time you "Set" it, but I could be wrong.

  3. #3
    davegri's Avatar
    davegri is offline Excess Access
    Windows 10 Access 2016
    Join Date
    May 2012
    Location
    Denver
    Posts
    3,388
    I think RuralGuy was on track. END WITH is missing:
    Code:
    With xlWB
     .Worksheets(1).Cells(2, 9) = RecNo
     .Worksheets(1).Cells(4, 9) = RemDate
     .Worksheets(1).Cells(6, 9) = mClient
     .Worksheets(1).Cells(7, 9) = Me.Add1
     .Worksheets(1).Cells(8, 9) = Me.Add2
     .Worksheets(1).Cells(9, 9) = Me.Town
     .Worksheets(1).Cells(10, 9) = Me.PostCode
     .Worksheets(1).Cells(13, 3) = Product
     .Worksheets(1).Cells(15, 9) = mClient
     .Worksheets(1).Cells(20, 9) = Me.Charge
     .Worksheets(1).Cells(22, 9) = mFOC
     .Worksheets(1).Cells(24, 9) = Me.TotalValue
     .Save
    End With
    xlWB.Close
    apXL.Quit
    Set apXL = Nothing

  4. #4
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,185
    Hi Thank you both, its the wood for the trees that we can't see

    Thanks

  5. #5
    ssanfu is offline Master of Nothing
    Windows 7 32bit Access 2010 32bit
    Join Date
    Sep 2010
    Location
    Anchorage, Alaska, USA
    Posts
    9,664
    My 2 cents....

    It looks like there might be a couple of places where the code could be/might be tightened up.
    Here is one:
    Code:
        TimeNow = Format(Now(), "hh:nn")
    
        If TimeNow >= "00:00" And TimeNow <= "11:59" Then
            TOD = "Good morning"
        ElseIf TimeNow >= "12:00" And TimeNow <= "16:59" Then
            TOD = "Good afternoon"
        ElseIf TimeNow >= "17:00" And TimeNow <= "23:59" Then
            TOD = "Good evening"
        End If

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 4
    Last Post: 04-28-2019, 07:19 PM
  2. Change text case from upper to proper case
    By s.nolan in forum Access
    Replies: 1
    Last Post: 12-02-2015, 10:56 AM
  3. Replies: 3
    Last Post: 10-27-2014, 07:37 AM
  4. Case for in case field corrupt
    By Ruegen in forum Forms
    Replies: 9
    Last Post: 08-03-2014, 07:56 PM
  5. Replies: 5
    Last Post: 10-23-2012, 03:55 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums