Posts by JimmyB

JimmyB · Jan 12th 2020

Hi. I'm stuck near the last line of code. All of the rest works great but I can't get the syntax right to delete a row of data on the line: Active sheet.rows(Sres).Delete Shift:= shiftxlUp

When I step through it I get the error "Type Mismatch

Any help will be appreciated

THANKS

Code

Sub DeleteSortedItem()

Dim Sitem
Dim RC As String
Dim SheetNum As StringShift:
Dim Rng As String
Dim rg As Range
Dim Sres




        Sheets("VALUES for MEALS").Activate
            Rng = Range("A65536").End(xlUp).Offset(4, 7)
            SheetNum = Rng
            'is the variable that holds the line number to be deleted
            
            RC = Range("A" & SheetNum)
            'is the variable that holds data in col "A"
        MsgBox Range("A" & SheetNum) 'this equalled "TEST" in col "A"
            
            ActiveSheet.Rows(SheetNum).Delete Shift:=xlShiftUp
        MsgBox RC 'This also equalled "TEST" in Col "A"
        
            'This block selects the line# to delete & saves data in variable RC _
            to compare with all category sheets (ie: calories, etc.) for deletion
            
            
           
            'Sitem = Sheets("VALUES for MEALS").Range("RC")
            Sitem = RC
            Set rg = Sheets("Calories").Range("A4:A600")
            Sheets("Calories").Activate
            Sres = rg.Find(Sitem)
            
        If Sres = RC Then
           Result = MsgBox("You are about to delete" & vbNewLine & "Meal Item..." & "*" & RC & "*" _
           & vbNewLine & vbNewLine & "To Continue Click  YES" & vbNewLine & "To Abort Click        NO", vbYesNo + vbExclamation, _
           "Delete Meal Item Box")
        
        MsgBox Sres 'Shows up as Test
        'MsgBox Sres.Address  'Shows up as A219
        
            If Result = vbYes Then
                ActiveSheet.Rows(Sres).Delete Shift:=xlShiftUp
            
                MsgBox "You just deleted" & vbNewLine & "Meal Item...." & RC
            Else
                MsgBox "No Problemo" & vbNewLine & "Just click 'OK' (below)" & vbNewLine & "and Try Again"
            End If
        End If
   End Sub

Display More

JimmyB · Jan 10th 2020

Hi Dave.

I did find one of my sheet names was incorrect. "Meal Chart" should have been "Meals Charts" (Plural). argghhh.

Line 63 of your code is where the password is cleared. I moved it to just before the rest of the delete happens...before line 142

I even tried to remove this line altogether to see if it may have been the issue and still got the below results

I update my code with yours. I got error on (set sh as wb.sheets... Object does not support method so I removed the wb and that worked. so set as:

sh = Sheets("Home Sheet")...seems good.

I placed a few msgbox's after the variables: User, Pass & Em. the first two show as .844444444 & the Em shows blank. I made sure that the ranges are correct. The code runs right to the 'Send' statement...error: "At least one of the from or sender fields is required and neither was found"

The original file has the password deleted from "Default Sheet". Can't see why. (Probably the problem) The new file is saved properly as necessary) in my folder but just not sent.

Thanks Jimmy

JimmyB · Jan 9th 2020

Hi Dave. I completed the saveas line as AtchFile, 51

I copied the code you provided into a copy of my program. (Is there a way to copy this without line numbers? When I copied it looked as though there was no line numbers, but when I pasted, somehow it included the line numbers, causing syntax error on every line. I went line for line and deleted the numbers LOL)

...Anyway

In the amended sub, you made a bit of an error on one of the sheets that you copied into the Array. You put "Disclaimer Then"...should be just "Disclaimer". You had mentioned that you had problem with the 'send' and I hoped that this was the problem, but no luck.

You mentioned that there may be a problem with the email code, but the email works perfectly when sending the full file...no issues at all.

Also there is personal content in the 'Default" sheet, such as email password etc., that must also be cleared before creating the new workbook (Lines 73 & 74) of my code That I sent in the #26 post above.

By creating the new workbook with no email password, should not be an issue, as we are using the original file to 'send'

I inserted the deletion just above the... Sheets(Array... line

Code

Application.ActiveWorkbook.Worksheets("Default Sheet").Select
 Range("B38,B44").ClearContents

When I run the program I get an error "Subscript out of range" on the new code: Sheets(Array.....

I really appreciate your help.

Thanks Jimmy

JimmyB · Jan 9th 2020

Hey guys. this is the closest that I've ever gotten on this problem. I tried some ideas from Uncle Striker. and have come to this: The file saves as xlsx in the proper location in my folder. It does not alter the original file, The file shuts down as needed. This is great...only problem is, it doesn't 'SEND' the file. I don't want to touch it until I get direction. ALSO: I'm not getting any errors, it just isn't sending the file. Ignore the rem statements. While altering the sub I just changed some of the code that I replaced to rem statements, so as not to lose it if I need to return.

Here's the code:

Thanks Jimmy

Code

Sub EmailDrFamily()

    Dim Msg As Object
    Dim Conf As Object
    Dim msgBody As String
    Dim ConfFields As Variant
    Dim wb As Workbook, sh As Worksheet
    Dim FilePath As String
    Dim FileName As String
    Dim FirstEmail
    Dim AtchFile As String
    Dim Usr
    Dim Pass
    Dim Ser
    Dim Nam
    Dim Em
    Dim Sento
    Dim Subj
    
    
    'THIS BLOCK STARTS THE ALLOW LESS APPS DECISION
    
         Call GYFamilyLessApps
    If Sheets("Home Sheet").Range("J45").Value = "Yes" Then
        Exit Sub
        
    End If
        'This tests if user chooses to look at instructions (disables sub)
        
    If Sheets("Home Sheet").Range("J45").Value = "Cancel" Then
        Sheets("Home Sheet").Range("A1").Activate
    End If
        'This tests if user decides not to set Less Secure (gives option to try or quit)
        
    If Sheets("Home Sheet").Range("J45").Value = "N0" Then
    End If
        'This tetss if user does not need instructions (continues with e-mail procedure)
        
     Range("J45").FormulaR1C1 = " "
     
        Result = MsgBox("Shall we continue to send message?" & vbNewLine & vbNewLine & _
        "Click Yes to continue with sending." & vbNewLine & "Click No to return to home page." _
        & vbNewLine & vbNewLine & "YES   =   CONTINUE" & vbNewLine & "NO   =   STOP! GO TO HOME", _
        vbYesNo + vbQuestion, "SEND E-MAIL")
    If Result = vbYes Then

    Else: Sheets("Home Sheet").Activate
    Exit Sub
    End If
        
    'THIS IS THE END OF THE ALLOW LWSS SECURE APPS AREA
    
    
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

        Set wb = ActiveWorkbook
        Set sh = wb.Sheets("Sheet1")
        Application.DisplayAlerts = False
    With sh
        FilePath = wb.Path & "\"
        FileName = Left(wb.Name, Len(wb.Name) - 5)
        AtchFile = FilePath & FileName & "-" & Format(Date, "ddmmyyy") & ".xlsx"
  
  'START OF DELETE SHEETS BLOCK
  
   Dim xWs As Worksheet
            Application.ScreenUpdating = False
            Application.DisplayAlerts = False
            
            Application.ActiveWorkbook.Worksheets("Default Sheet").Select
            Range("B38,B44").ClearContents
            
    For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "Default Sheet" And xWs.Name <> "Exercise Chart" _
            And xWs.Name <> "BP Chart" And xWs.Name <> "INR Chart" _
            And xWs.Name <> "Weight Chart" And xWs.Name <> "Glucose Chart" _
            And xWs.Name <> "Meals Chart" And xWs.Name <> "Exercise Data" _
            And xWs.Name <> "BP Data" And xWs.Name <> "INR Data" _
            And xWs.Name <> "Weight Data" And xWs.Name <> "Glucose Data" _
            And xWs.Name <> "Meals Data" And xWs.Name <> "Sign In" _
            And xWs.Name <> "LOG ENTRIES" And xWs.Name <> "Disclaimer" Then
        xWs.Delete
        End If
    Next
         
    'END OF DELETE SHEETS BLOCK
    
            Application.DisplayAlerts = True
            Application.ScreenUpdating = True
            Application.ActiveWorkbook.Worksheets("Sign In").Select
    
    With ActiveWorkbook
        .SaveAs AtchFile, 51
        .Close
    End With
    
    
    End With
    
   ' With Application.FileDialog(msoFileDialogFolderPicker)
    '    .Title = "Please just click on any folder and click OK below, to activate the email"
     '   .AllowMultiSelect = False
      '  .Show
  '      If .SelectedItems.Count = 0 Then
   '         MsgBox "You did not select a folder.  Please try again." & vbNewLine & "The folder is just used as a temporary holding area so the file can be sent"
    '        Exit Sub
     '   Else
      '      FilePath = .SelectedItems(1) & "\"
 '       End If
  '  End With
    
   '     FileName = wb.Name
    '    wb.SaveCopyAs FilePath & FileName
        
        Set Msg = CreateObject("CDO.Message")
        Set Conf = CreateObject("CDO.Configuration")
        
    Sheets("Default Sheet").Select
        'Below sets email username, password, address, parients name & subject variables
    
        Usr = Range("B43").Value
        Pass = Range("B44").Value
        Em = Range("B45")
        Nam = Range("B39")
    Sheets("Home Sheet").Select
        Subj = Range("C34")
        
        'The next 3 "IF" blocks determine which email server you are using from your default sheet
        
    If wb.Sheets("Default Sheet").Range("E43").Value = "gmail" Then
    
    Sheets("Home Sheet").Range("A42:C42").Select
    With Selection
        .ClearContents
        .Interior.ColorIndex = vb0
        'Clearing "Sent & Date & Time" as the patient is sending a new email
    End With
    Sheets("Default Sheet").Select
        Conf.Load -1
        'CDO Source Defaults
        Set ConfFields = Conf.Fields
    With ConfFields
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        'Enter the username and password of your email account below
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Usr
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Pass
        'Edit the SMTP server below e.g. smtp.gmail.com or smtp.mail.yahoo.co.uk
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Smtp.gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
        .Update
    End With
    End If
    
    If wb.Sheets("Default Sheet").Range("E43").Value = "yahoo" Then
    
    Sheets("Home Sheet").Range("A42:C42").Select
    With Selection
        .ClearContents
        .Interior.ColorIndex = vb0
        'Clearing "Sent & Date & Time" as the patient is sending a new email
    End With
    Sheets("Default Sheet").Select
    
        Conf.Load -1
        'CDO Source Defaults
        Set ConfFields = Conf.Fields
    With ConfFields
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        'Enter the username and password of your email account below
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Usr
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Pass
        'Edit the SMTP server below e.g. smtp.gmail.com or smtp.mail.yahoo.co.uk
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.mail.yahoo.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With
    End If
    
     
    
        FirstEmail = Sheets("Default Sheet").Range("B46").Value
        'This variable is set to Dr Family
        
        Sento = Sheets("Default Sheet").Range("A46")
        'This variable is set to place name of recipient in MsgBody
    
        msgBody = "Hi" & Sento & vbNewLine & vbNewLine & _
              "Please find the Excel workbook attached."
              
    MsgBox FileName
    MsgBox AtchFile
   '     With Workbooks("FileName")
    '        .Close
     '   End With
    ' ActiveWorkbook.Close SaveChanges:=True
     
        
    With Msg
        Set .Configuration = Conf
        'Add the email address to whom to send the email below
        .To = FirstEmail
        .CC = ""
        .BCC = ""
        .From = Em
        .Subject = Subj
        .TextBody = msgBody
        .AddAttachment AtchFile, 51
        .Send
    End With
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
    Sheets("Home Sheet").Select
        Range("C42").Select
    With ActiveCell
        .FormulaR1C1 = "SENT"
        .Font.Bold = True
        .Font.Size = 28
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Font.Color = vbBlack
        .Interior.ColorIndex = 38
        Call Pause1
        .Interior.Color = vbYellow
        Call Pause1
        .Interior.Color = vbGreen
    End With
    
        Range("A42").Select
    With ActiveCell
        .FormulaR1C1 = "=Today()"
        .Copy
        .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        .Interior.Color = vbGreen
    End With
    
        Range("B42").Select
    With ActiveCell
        .Value = Format(Now(), "HH:MM")
        .Interior.Color = vbGreen
    End With
        Call GYDisallowLessSecureApps
End Sub

Display More

JimmyB · Jan 8th 2020

BTW I used your code from #11 thread

JimmyB · Jan 8th 2020

Any suggestions will try tomorrow...gotta go for now...Thanks all

JimmyB · Jan 8th 2020

Hi Uncle Stringer

I tried your suggestion. it saved as xlsx as I wanted, but it doesn't send. I get the error: 'Process cannot access the file because it is being used by another process'. It does come up as the xlsx file on my screen...therefore that's likely why I'm getting the error. Need it to not open on my screen somehow?

Jimmy

JimmyB · Jan 8th 2020

Hey Uncle Stringer & Dave. Sorry I didn't get a chance to try your suggestions. It seems reasonable. Will look harder at them when I clear my mind. LOL Working on Roy's recommendations

I need it to open as xlsx, as I don't want the copy to be sent from the user to the physician, with error messages [opping up when they hit the form control buttons. It must be clean. It will be initially sent from me to the user, then altered and sent to their recipients (redacted) for viewing only.

The whole program works great except for this: "Cannot find path specified" and highlights the line just before the 'Send' line. If not trying to delete the selected sheets and change to xlsx it sends great as xlsm.

I've found where it's changed the file but the sub can't find it when time to 'SEND'

arggghhh

JimmyB · Jan 8th 2020

Hi Roy From your questions:

Question OnLine 28: The program has the built in feature to send email with the CDO and g-mail requires the user to activate “Allow less secure apps”. I’m giving the user the option to opt out in case they don’t feel safe. Sub: GYFamilyLessApps that I’m calling before this, uses msgbox to determine this... and place value in J45 (Works Perfectly)

Question OnLine 40: This bolsters the previous decision and allows them to either continue to email or opt out (Works Perfectly)

I didn't see anything new except for the questions (above) in the sub that you included in your last post...did I miss something

JimmyB · Jan 7th 2020

Dave, for pete's sake. I'm not trying to be rude to anyone. If you are offended I'm sorry. That was not my intent. I am a newby to VBA and not as well versed as the rest of you are. I can't see the connection to all three posters. In the instructions of the forum we are compelled to be patient. I was just being patient. I meant to get back to you but I was just waiting for Roy to respond. RoyUK was advising me in one direction...I was trying out his suggestions and he was responding. You are giving me suggestions that I don't understand, from another direction. uncle stringer advising that I'm just confusing everything. Well...Yeah...I'm confused.

So thanks so very much for your help, but I need to choose something. Please don't be offended...not my intention at all.

Jimmy

JimmyB · Jan 7th 2020

Please don't take this the wrong way Uncle Stringer...If I jump back and forth that would be counter productive and rude. The program has over 30 sheets all interacting with each other and I'm very close to completion. Thanks anyway

I'm hoping to hear from RoyUK over-night with further suggestions

JimmyB · Jan 7th 2020

Sorry Uncle Stringer... With all due respect, I'm in the middle of working with RoyUK and don't want to jeopardize the advancements that we've made. He's been helping me all along with many facets of my complex program, and knows what I need to accomplish this feat.

I'll contact you if necessary.

Thanks for your consideration

Jimmy

JimmyB · Jan 4th 2020

Hi Roy

I tried to just change up the line that you gave me and I get an error: 'Wrong number of arguments or invalid property assignment.'

In your thread you mentioned I should change my current saveas code. Not too sure exactly how to fit in the fileformat:=51 code. currently my saveas line is below:

Thanks

Code

wb.SaveAs FilePath & FileName & Format(Date, "ddmmyyyy") & ".xlsx", FileFormat:= _
 xlOpenXMLWorkbook, CreateBackup:=False

JimmyB · Jan 3rd 2020

Yeah Roy the FileName does look weird, but the file does exists in the specified path as xlsx (non macro as I need... but the code block on lines 184 to 200 does not activate my deletion... (all of the sheets are still in the program)). If you look back on the code in thread #1, you can see on lines 69 to 74 is where the 'saveas' is done. I got the code from someone here, when I asked how to convert & saveas from xlsm to xlsx.

(I want xlsx, as the programs' recipient will likely not have macros enabled).

Thanks

JimmyB · Jan 3rd 2020

Hey Roy...Hi Rory...hey Dave

In answer to Roy... Just before the 'send line', I msgbox the FilePath and then the FileName. The path was exactly what I picked in the 'folder Picker' area of the sub c:\User\Me\Documents\Recipes Main File\

Msgbox FileName (as Rory suggested) had the full filepath and filename c:\User\Me\Documents\Recipes Main File\ jj.xlsm02012020.xlsx (which I think is perfect)

So, I tried changing the line before the send from FilePath & FileName to Just FileName and now getting the error: 'Process cannot access the file because it is being used by another process'. I think we're getting close.

Dave. the name must be changed because the original file is to be retained by the user and the altered file is to be sent to the recipient.

Thanks to you all

JimmyB · Jan 2nd 2020

Happy New Year

I need to send my excel file through my macro. It seems to do everything that I need it to but won't send. I get the error: "Cannot find path specified" and highlights the line just before the 'Send' line. The file needs to be converted to xlsx, because the receiver will probably not have Macros activated. . When it comes to sending the file, it can't find it.

Any help would be greatly appreciated. This problem has been a thorn in my side for quite a while. Thanks so much

Code

Sub EmailDrFamily()

    Dim Msg As Object
    Dim Conf As Object
    Dim msgBody As String
    Dim ConfFields As Variant
    Dim wb As Workbook
    Dim FilePath As String
    Dim FileName As String
    Dim FirstEmail
    Dim Usr
    Dim Pass
    Dim Ser
    Dim Nam
    Dim Em
    Dim Sento
    Dim Subj
   
         Call GYFamilyLessApps
    If Sheets("Home Sheet").Range("J45").Value = "Yes" Then
        Exit Sub
       
    End If
        'This tests if user chooses to look at instructions (disables sub)
       
    If Sheets("Home Sheet").Range("J45").Value = "Cancel" Then
        Sheets("Home Sheet").Range("A1").Activate
    End If
        'This tests if user decides not to set Less Secure (gives option to try or quit)
       
    If Sheets("Home Sheet").Range("J45").Value = "N0" Then
    End If
        'This tetss if user does not need instructions (continues with e-mail procedure)
       
     Range("J45").FormulaR1C1 = " "
     
        Result = MsgBox("Shall we continue to send message?" & vbNewLine & vbNewLine & _
        "Click Yes to continue with sending." & vbNewLine & "Click No to return to home page." _
        & vbNewLine & vbNewLine & "YES   =   CONTINUE" & vbNewLine & "NO   =   STOP! GO TO HOME", _
        vbYesNo + vbQuestion, "SEND E-MAIL")
    If Result = vbYes Then

    Else: Sheets("Home Sheet").Activate
    Exit Sub
    End If
       
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

        Set wb = ActiveWorkbook
   
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please just click on any folder and click OK below, to activate the email"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count = 0 Then
            MsgBox "You did not select a folder.  Please try again." & vbNewLine & "The folder is just used as a temporary holding area so the file can be sent"
            Exit Sub
        Else
            FilePath = .SelectedItems(1) & "\"
        End If
    End With
   
        FileName = wb.Name
        'wb.SaveCopyAs FilePath & FileName
       
        wb.SaveAs FilePath & FileName & Format(Date, "ddmmyyyy") & ".xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
        DisplayAlerts = False
       
        ''/// get the path and name of the saved copy to attach
        FileName = Workbooks(Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) & ".xlsx").FullName
       
        Set Msg = CreateObject("CDO.Message")
        Set Conf = CreateObject("CDO.Configuration")
       
    Sheets("Default Sheet").Select
        'Below sets email username, password, address, parients name & subject variables
   
        Usr = Range("B43").Value
        Pass = Range("B44").Value
        Em = Range("B45")
        Nam = Range("B39")
    Sheets("Home Sheet").Select
        Subj = Range("C34")
       
        'The next 3 "IF" blocks determine which email server you are using from your default sheet
       
    If wb.Sheets("Default Sheet").Range("E43").Value = "gmail" Then
   
    Sheets("Home Sheet").Range("A42:C42").Select
    With Selection
        .ClearContents
        .Interior.ColorIndex = vb0
        'Clearing "Sent & Date & Time" as the patient is sending a new email
    End With
    Sheets("Default Sheet").Select
        Conf.Load -1
        'CDO Source Defaults
        Set ConfFields = Conf.Fields
    With ConfFields
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        'Enter the username and password of your email account below
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Usr
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Pass
        'Edit the SMTP server below e.g. smtp.gmail.com or smtp.mail.yahoo.co.uk
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Smtp.gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
        .Update
    End With
    End If
   
    If wb.Sheets("Default Sheet").Range("E43").Value = "yahoo" Then
   
    Sheets("Home Sheet").Range("A42:C42").Select
    With Selection
        .ClearContents
        .Interior.ColorIndex = vb0
        'Clearing "Sent & Date & Time" as the patient is sending a new email
    End With
    Sheets("Default Sheet").Select
   
        Conf.Load -1
        'CDO Source Defaults
        Set ConfFields = Conf.Fields
    With ConfFields
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        'Enter the username and password of your email account below
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Usr
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Pass
        'Edit the SMTP server below e.g. smtp.gmail.com or smtp.mail.yahoo.co.uk
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.mail.yahoo.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With
    End If
   
     If wb.Sheets("Default Sheet").Range("E43").Value = "outlook" Then
     
     Sheets("Home Sheet").Range("A42:C42").Select
    With Selection
        .ClearContents
        .Interior.ColorIndex = vb0
        'Clearing "Sent & Date & Time" as the patient is sending a new email
    End With
    Sheets("Default Sheet").Select
   
        Conf.Load -1
        'CDO Source Defaults
        Set ConfFields = Conf.Fields
    With ConfFields
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        'Enter the username and password of your email account below
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = Usr
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Pass
        'Edit the SMTP server below e.g. smtp.gmail.com or smtp.mail.yahoo.co.uk
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp-mail.outlook.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587
        .Update
    End With
    End If
   
        FirstEmail = Sheets("Default Sheet").Range("B46").Value
        'This variable is set to Dr Family
       
        Sento = Sheets("Default Sheet").Range("A46")
        'This variable is set to place name of recipient in MsgBody
   
        msgBody = "Hi" & Sento & vbNewLine & vbNewLine & _
              "Please find the Excel workbook attached."
Dim xWs As Worksheet
 
            Application.ScreenUpdating = False
            Application.DisplayAlerts = False
           
            Application.ActiveWorkbook.Worksheets("Default Sheet").Select
            Range("B38,B44").ClearContents
           
    For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "Default Sheet" And xWs.Name <> "Exercise Chart" _
            And xWs.Name <> "BP Chart" And xWs.Name <> "INR Chart" _
            And xWs.Name <> "Weight Chart" And xWs.Name <> "Glucose Chart" _
            And xWs.Name <> "Meals Chart" And xWs.Name <> "Exercise Data" _
            And xWs.Name <> "BP Data" And xWs.Name <> "INR Data" _
            And xWs.Name <> "Weight Data" And xWs.Name <> "Glucose Data" _
            And xWs.Name <> "Meals Data" And xWs.Name <> "Sign In" _
            And xWs.Name <> "LOG ENTRIES" And xWs.Name <> "Disclaimer" Then
        xWs.Delete
        End If
    Next
            Application.DisplayAlerts = True
            Application.ScreenUpdating = True
            Application.ActiveWorkbook.Worksheets("Sign In").Select
           

    With Msg
        Set .Configuration = Conf
        'Add the email address to whom to send the email below
        .To = FirstEmail
        .CC = ""
        .BCC = ""
        .From = Em
        .Subject = Subj
        .TextBody = msgBody
        .AddAttachment FilePath & FileName
       
        .Send
    End With
   
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
   
    Sheets("Home Sheet").Select
        Range("C42").Select
    With ActiveCell
        .FormulaR1C1 = "SENT"
        .Font.Bold = True
        .Font.Size = 28
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Font.Color = vbBlack
        .Interior.ColorIndex = 38
        Call Pause1
        .Interior.Color = vbYellow
        Call Pause1
        .Interior.Color = vbGreen
    End With
   
        Range("A42").Select
    With ActiveCell
        .FormulaR1C1 = "=Today()"
        .Copy
        .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        .Interior.Color = vbGreen
    End With
   
        Range("B42").Select
    With ActiveCell
        .Value = Format(Now(), "HH:MM")
        .Interior.Color = vbGreen
    End With
        Call GYDisallowLessSecureApps
End Sub

Display More

JimmyB · Dec 30th 2019

Problem solved. Thanks ASHU

I don't know how to mark my post as 'solved'. Any suggestions?

JimmyB

OOPSS never mind I figured it out

JimmyB · Dec 29th 2019

Does anyone else have an idea on how to clear the "Can't enter break mode at this time". I would really like to know how to defeat this error.

Thanks JimmyB

JimmyB · Dec 23rd 2019

Well You know That's a good idea. I can use an if condition like you recommended if I have to, but it's driving me nuts. The code I'm using should work and it is cleaner than going around the problem. I just can't figure out why I get the error. I googled it and not getting any results either.

JimmyB · Dec 23rd 2019

Thanks Ashu, but that isn't an option. I'll be distributing the apps thousands of times (plan) and I need it to automatically delete this line of code after I've assigned a password to the file. I can't load the program each time...really not feasible...But thanks for the suggestion. really appreciate it

JimmyB

Posts by JimmyB

Delete row of data on worksheet

Error: Cannot find path specified when sending my attachment with CDO

Error: Cannot find path specified when sending my attachment with CDO

Error: Cannot find path specified when sending my attachment with CDO

Error: Cannot find path specified when sending my attachment with CDO

Error: Cannot find path specified when sending my attachment with CDO

Error: Cannot find path specified when sending my attachment with CDO

Error: Cannot find path specified when sending my attachment with CDO

Error: Cannot find path specified when sending my attachment with CDO

Error: Cannot find path specified when sending my attachment with CDO

Error: Cannot find path specified when sending my attachment with CDO

Error: Cannot find path specified when sending my attachment with CDO

Error: Cannot find path specified when sending my attachment with CDO

Error: Cannot find path specified when sending my attachment with CDO

Error: Cannot find path specified when sending my attachment with CDO

Error: Cannot find path specified when sending my attachment with CDO

Can't enter break mode at this time

Can't enter break mode at this time

Can't enter break mode at this time

Can't enter break mode at this time