I've got an Excel spreadsheet built by someone else that sends an email to a group via a scheduled task, or at least used to. It recently stopped working. I don't have the time to rebuild his whole Rube Goldberg / Wile E. Coyote system at the moment, so I'm trying to fix it.
In one of the excel documents, this code exists
Set rng = Nothing
On Error Resume Next
Set rng = Sheets("Weight").Range("A2")
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "eric.lizotte#.com"
.CC = ""
.BCC = ""
.Subject = Sheets("Weight").Range("A1")
.HTMLBody = Convert.ToString(rng)
.Send
End With
whenever I see so many "on error resume next" in something I grit my teeth.
What's happening is that it "works" but the email it sends is blank. In debug I can see that the subject content and body content both exist and have values. I rewrote it to be
OutMail.To = "eric.lizotte#.com"
OutMail.CC = ""
OutMail.BCC = ""
OutMail.Subject = Sheets("Weight").Range("A1")
OutMail.HTMLBody = Convert.ToString(rng)
OutMail.Send
and threw a debug point on the send, and checked the properties of outmail, and the subject and htmlbody have values. I can't figure out why after the send they are blank.
Given you are automating another application you probably should not rely on the default property of the range - just specify the property you want e.g. Value:
OutMail.Subject = Sheets("Weight").Range("A1").Value
OutMail.HTMLBody = rng.Value
You might also try the Text property for the HTMLBody:
OutMail.HTMLBody = rng.Text
You can then be confident that you are assigning a String to the mail properties which is what it expects.
Related
So there are several SO questions and Google results that come up under "On Error GoTo executes once" and in just about every case the recommended solution is to add Err.Clear or some forum of Resume to clear the error out. VBA errors can only be handled one at a time, so they need to be cleared.
Having implemented these, as you might have guessed, I am running into this issue where the On Error GoTo is only executing once and I can't figure out why.
Below is my loop. I did leave some code off the top because there is quite a bit of it and it isn't relevant. Mostly user prompts and making arrays. To explain a little what is going on, conos() is an array containing the values of a specific column. Based on a segment of the filename, it searches for the code in the array, to get its index, which corresponds to the row.
If there isn't a Match it triggers the error. That just means there is a file, but no contact to send it to. It should skip to NoContact and create a list of these files.
So with my files, the first has a contact and generates the email, the second does not and skips to NoContact and adds the file to the list. Five more run with contacts and then it gets to another that should go to NoContact, but Unable to get the Match property of the WorksheetFunction class comes up.
It seems the error isn't getting cleared from the first one. Not sure why.
For Each objFile In objFolder.Files
wbName = objFile.Name
' Get the cono along with handling for different extensions
wbName = Replace(wbName, ".xlsx", "")
wbName = Replace(wbName, ".xlsm", "")
wbName = Replace(wbName, ".xls", "")
' Split to get just the cono
fileName() = Split(wbName, "_")
cono = fileName(2)
' Create the cell look up
c = Cells(1, WorksheetFunction.Match("Cono", cols(), 0)).Column
' ******************** ISSUE IS HERE ***************************
On Error GoTo NoContact
r = Cells(WorksheetFunction.Match(cono, conos(), 0), c).Row
Cells(r, c).Select
' Fill the variables
email = Cells(r, c).Offset(0, 1).Value
firstName = Cells(r, c).Offset(0, 3).Value
lastName = Cells(r, c).Offset(0, 4).Value
account = Cells(r, c).Offset(0, -2).Value
username = Cells(r, c).Offset(0, 6).Value
password = Cells(r, c).Offset(0, 7).Value
fPassword = Cells(r, c).Offset(0, 8).Value
' Mark as completed
Cells(r, c).Offset(0, 9).Value = "X"
' Set the object variables
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
' Body of the email
str = "Hi " & firstName & "," & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
' Parameters of the email
On Error Resume Next
With OutMail
.To = email
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = str
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
End With
On Error GoTo 0
' Based on the user prompts, whether or not the emails will be sent without checking them first
If finalCheck = vbYes Then
OutMail.Send
Else
OutMail.Display
End If
NoContact:
' Determiine which files don't have a corresponding email and add to list
If email = Empty Then
If conoB <> "" Then
conoB = conoB & ", " & cono
Else
conoB = cono
End If
End If
Err.Clear
' Clear variables for next use
Set OutMail = Nothing
Set OutApp = Nothing
cono = Empty
email = Empty
firstName = Empty
lastName = Empty
account = Empty
username = Empty
password = Empty
fPassword = Empty
Next:
Err.Clear just clears the information regarding the last error from the Err object - it does not exit out of error handling mode.
If an error is detected and your On Error GoTo NoContact is invoked, your code jumps down to the NoContact label, and then finally finds it way back to the start of your For Each objFile In objFolder.Files loop while still in error-handling mode.
If another error occurs while still in error-handling mode, VBA throws the error as it can no longer trap it.
You should structure your code along the lines of
For Each objFile In objFolder.Files
'...
On Error GoTo NoContactError
'...
NoContact:
'...
Next
'...
Exit Sub
NoContactError:
'Error handling goes here if you want it
Resume NoContact
End Sub
But, as Tim Williams, commented - it is much better to avoid situations that require On Error error-handling whenever possible.
I am having trouble solving an error that occurs when sending an email through excel. At the moment it is set so that when a drop down list is titled "Open" in column "N" it send an email to a specific person who's email address appears in column "M" (I select the name for emailing in "J" and it creates the address in "M"). I think the problem could be that it checks every row that I have "Open" in "N" and so when there is no email address it throws up the "Run-time error '13': Type Mismatch." I currently have the following code:
In Sheet 1 (Issue Sheet):
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("N3")) Is Nothing Then
Select Case Range("N3")
Case "Open": Macro1
End Select
End If
End Sub
and my Module being:
Option Explicit
Sub Macro1()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("M").Cells
If cell.Value Like "?*#xyz.com" And _
LCase(Cells(cell.Row, 14).Value) = "open" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Open Issue"
.Body = "Dear " & Cells(cell.Row, "J").Value _
& vbNewLine & _
"Issue raised: " & Cells(cell.Row, "C").Value _
& vbNewLine & _
"Regards"
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'Or use Display
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Essentially what I want it to do is be able to send an email only to the address, in the row that the "Open" drop down is selected from i.e "Open" chosen in column "N" and then will send email only to the address in "M" of that row. I need this to be expandable too so I can go down several rows and only send email from that one.
I am addressing only the error in the title, I haven't looked at the rest of the code or whether it does what you want. Your problem is in this line
LCase(Cells(cell.Row, "N").Value) = "open" Then
Cells() is expecting a row number and a column number but you are using a string ("N") as the column number, thats a type mismatch, if you want column "N" then use the number 14 like this
LCase(Cells(cell.Row, 14).Value) = "open" Then
I am having some trouble referencing an email address from a different sheet so I can send an email when a certain name is selected and "open" is chosen from a drop down box it will automatically send an email to that person. I have so far:
Sub Macro1()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("M").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*#xyz.com" And _
LCase(Cells(cell.Row, "N").Value) = "open" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Open Issue"
.Body = "Dear " & Cells(cell.Row, "J").Value _
& vbNewLine & _
"Issue raised: " & Cells(cell.Row, "C").Value _
& vbNewLine & _
"Regards"
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
This works if I input an email address in to column M manually but I am trying to have it so that when a name is selected from a drop down box in J it matches up the email to the name and sends it when "open" is selected from column N.
I have created a table with names and emails in another sheet which M uses VLookup to reference using =VLOOKUP(J3,Team!B5:E8,4,FALSE). I have tried adding HYPERLINK in front of VLOOKUP but it still doesn't create a link.
I also tried creating the email address from the names using split and concatenate but to no avail.
Your problem is that you use SpecialCells(xlCellTypeConstants). Once you made column M a formula your code will now ignore all the cells that have formulas in column M.
You can adjust the xlCellTypeConstants to xlCellTypeFormulas or just get rid of SpecialCells altogether to include both.
I want to know when and possibly where my .doc file is opened. If document is copied from my PC and opened on another PC I want to email me on which PC document is opened.
Here is a potential solution, however, there are still many variables at play that can prevent an email being sent. The below VBA is inserted in the Document_Open event handler. The method is sending an email through the Outlook application so the user who opens the file would need to have that installed too.
Option Explicit
Private Sub Document_Open()
'only run when others open
If Application.userName <> "My Name" Then
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Dim outApp As Object
Dim outMail As Object
Dim strBody As String
Dim userName As String
Set outApp = CreateObject("Outlook.Application")
Set outMail = outApp.createitem(0)
userName = Application.userName
strBody = userName & " has opened my file"
With outMail
.To = "myEmail#myDomain.com"
.CC = ""
.BCC = ""
.Subject = "My file has been opened"
.Body = strBody
'.Display
.Send
End With
Set outMail = Nothing
Set outApp = Nothing
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
End If
End Sub
The above runs smoothly but I end up with a security warning on my laptop (I am not sure if this is true across everyone else's). However, hopefully this gives you a starting point for you to tinker with to get the complete results.
The only way I can think of is to write a VBA module within the word document that will fire on the onOpen event to create and send an email using the hosts default email program. Or you could attempt to send an email using CDO or maybe even sendmail within word using VBA. Note that if the person opening the document has macros disabled, the VBA module may not run.
I am running a macro through a vb script that imports more than 1000 records from database and copies them into an excel sheet and then send an email saying that the report is ready. When i import less records(100 or 200) it is running fine. But when I import the entire records(more than 1000), I get a window message "Microsoft Excel is waiting for another application to complete an OLE action " even though the program is running fine .
Is there any way to hide this message. Also, If i hide this message, will the program continues to run? Below is my code:
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
Set rst = New ADODB.Recordset
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
cn.Open ("User ID=flt" & _
";Password=flts1hp" & _
";Data Source=SIH_PROD" & _
";Provider=MSDAORA.1" & _
";PLSQLRSet=0")
Set oxcel = New Excel.Application
Set wbk = oxcel.Workbooks.Add()
With oxcel
.ActiveSheet.Name = "Report"
strFileName = "C:\Users\extract.xlsx"
'headings
For i = 0 To rs.Fields.Count - 1
.Cells(row, col) = rs.Fields(i).Name
.Rows(row).RowHeight = 45
.Cells(row, col).WrapText = True
col = col + 1
Next
.Range("A2").Select
.Selection.CopyFromRecordset rs
With wbk
.Application.DisplayAlerts = False
On Error GoTo Error_Message
.SaveAs (strFileName), AccessMode:=xlExclusive, _
ConflictResolution:=Excel.XlSaveConflictResolution.xlLocalSessionChanges
.Close
End With
.Quit
End With
With OutMail
.To = "vinod.chelladurai#abc.com"
.CC = ""
.BCC = ""
.Subject = "Done"
.Body = "Done"
.Send
End With
Set OutApp = Nothing
Set OutMail = Nothing
End Sub
by reading your Question(withouth getting into your code)
Yes - Alert message can be Diabled using
`Application.DisplayAlerts = False`
but that won't solve the problem ,
your programme will still not execute.Since there will be some deadlocks in function calls, (I have had this problem once )
Try debuggin with breakpoint and narrow it down to the erroneous function call
Hope this will help
You can use this code before the long running tasks
Application.IgnoreRemoteRequests = True
Can put it back to original after the task ends using Application.IgnoreRemoteRequests = False
I had this issue for an other strange reason : in an Excel script I was writting to an other excel workbook. And sometimes, this message appeared. What a mess for debugging such situation because everything is blocked until you kill the target excel file (the one where I was supose to write inside).
At the end, I found the problem : a bug of Office 2013 (because this pb doesn't exist in Office 2010) ? I was trying to put a text (but not so big, in reality, with some vbLf inside...) in a standard cell, with a standard width. By changing the size of the column to 100 (at the end, something different from the original standard size), before writing inside the pb disappered!
Ex. before writing in the cells :
DocExcel.Sheets(1).Select
DocExcel.Sheets(1).Cells.ColumnWidth = 100
DocExcel.Sheets(1).Cells(1, 1).Select
Strange but it works...