M
Mark A. Sam
Hello,
I have been using the following procedure for years, but recenlty I get an
error,
Error 1046: The command or action 'SendObject' isn't available now.
The table CompanyInfoSQL is a linked SQL Server table from a remote server.
The code runs from a Timer Event in a a app with a hidden database window.
Ther procedure is called from another event procedure. The code runs fine
other than the Email not being sent (SendObject).
Thanks for any help and God Bless,
Private Sub Send_Click()
On Error GoTo error_Section
Dim rst As DAO.Recordset
Dim strSQL As String
Dim strMessage As String
strSQL = "SELECT CompanyID, pw, Company, Contact, Phone AS [Contact
Phone], Email AS [Contact Email], DisplayPhone AS [Display Phone],
DisplayEmail AS [Display Email], emailReg, emailRegWhen " & _
"From CompanyInfoSQL " & _
"WHERE ([emailReg] = 0 Or emailReg Is Null);"
Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)
rst.MoveLast
If rst.RecordCount = 0 Then
GoTo exit_Section
End If
rst.MoveFirst
Do Until rst.EOF
strMessage = "Welcome to Truckloads.Net. Below is your Registration
Information. Please retain it for future reference. "
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & "Sign In information. (This is needed for
Posting)"
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & "Company ID: " & rst![CompanyID]
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Password: " & rst![pw]
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & "Sign In at
http://www.truckloads.net/aspSQL/companykey.asp"
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & "You can Search with out Signing In at:"
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Loads:
http://www.truckloads.net/aspSQL/searchloads.asp"
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Trucks:
http://www.truckloads.net/aspSQL/searchtrucks.asp"
strMessage = strMessage & vbNewLine & vbNewLine & vbNewLine
strMessage = strMessage & ">>> LOOK >>> Get the Market Rate for any lane
in the US and Canada: http://www.truckloadrate.com/index_tl.htm"
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & "Other Registration Information:"
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & "Company: " & rst![Company]
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Contact: " & rst![Contact]
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Contact Phone: " & rst![Contact Phone]
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Contact Email: " & rst![Contact Email]
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Display Phone: " & rst![Display Phone]
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Display Email: " & rst![Display Email]
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & "You can change this information by Signing In:
http://www.truckloads.net/aspSQL/companykey.asp"
' strMessage = strMessage & vbNewLine & vbNewLine
DoCmd.SendObject , , , rst![Contact Email], , "(e-mail address removed)",
"Welcome to Truckloads.Net", strMessage, False
rst.Edit
rst![emailReg] = -1
rst![emailRegWhen] = Now()
rst.Update
rst.MoveNext
Loop
'Beep 'for testing
exit_Section:
On Error Resume Next
rst.Close
Set rst = Nothing
Exit Sub
error_Section:
If Err = 3021 Then
Resume Next
Else
MsgBox "Error " & Err & ": " & Err.Description
'Resume exit_Section
Resume Next
End If
End Sub
I have been using the following procedure for years, but recenlty I get an
error,
Error 1046: The command or action 'SendObject' isn't available now.
The table CompanyInfoSQL is a linked SQL Server table from a remote server.
The code runs from a Timer Event in a a app with a hidden database window.
Ther procedure is called from another event procedure. The code runs fine
other than the Email not being sent (SendObject).
Thanks for any help and God Bless,
Private Sub Send_Click()
On Error GoTo error_Section
Dim rst As DAO.Recordset
Dim strSQL As String
Dim strMessage As String
strSQL = "SELECT CompanyID, pw, Company, Contact, Phone AS [Contact
Phone], Email AS [Contact Email], DisplayPhone AS [Display Phone],
DisplayEmail AS [Display Email], emailReg, emailRegWhen " & _
"From CompanyInfoSQL " & _
"WHERE ([emailReg] = 0 Or emailReg Is Null);"
Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset, dbSeeChanges)
rst.MoveLast
If rst.RecordCount = 0 Then
GoTo exit_Section
End If
rst.MoveFirst
Do Until rst.EOF
strMessage = "Welcome to Truckloads.Net. Below is your Registration
Information. Please retain it for future reference. "
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & "Sign In information. (This is needed for
Posting)"
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & "Company ID: " & rst![CompanyID]
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Password: " & rst![pw]
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & "Sign In at
http://www.truckloads.net/aspSQL/companykey.asp"
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & "You can Search with out Signing In at:"
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Loads:
http://www.truckloads.net/aspSQL/searchloads.asp"
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Trucks:
http://www.truckloads.net/aspSQL/searchtrucks.asp"
strMessage = strMessage & vbNewLine & vbNewLine & vbNewLine
strMessage = strMessage & ">>> LOOK >>> Get the Market Rate for any lane
in the US and Canada: http://www.truckloadrate.com/index_tl.htm"
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & "Other Registration Information:"
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & "Company: " & rst![Company]
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Contact: " & rst![Contact]
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Contact Phone: " & rst![Contact Phone]
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Contact Email: " & rst![Contact Email]
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Display Phone: " & rst![Display Phone]
strMessage = strMessage & vbNewLine
strMessage = strMessage & "Display Email: " & rst![Display Email]
strMessage = strMessage & vbNewLine & vbNewLine
strMessage = strMessage & "You can change this information by Signing In:
http://www.truckloads.net/aspSQL/companykey.asp"
' strMessage = strMessage & vbNewLine & vbNewLine
DoCmd.SendObject , , , rst![Contact Email], , "(e-mail address removed)",
"Welcome to Truckloads.Net", strMessage, False
rst.Edit
rst![emailReg] = -1
rst![emailRegWhen] = Now()
rst.Update
rst.MoveNext
Loop
'Beep 'for testing
exit_Section:
On Error Resume Next
rst.Close
Set rst = Nothing
Exit Sub
error_Section:
If Err = 3021 Then
Resume Next
Else
MsgBox "Error " & Err & ": " & Err.Description
'Resume exit_Section
Resume Next
End If
End Sub