Hello, I need help for an issue I have with the following code. I am trying to run an email macro in access which had been successfully run before. I am taking this process over and new to this so I am having a hard time troubleshooting it. The "Run-time '91' - Object variable or With block variable not set" comes up so I have tried to debug it. Below is the code for the macro. The error seems to be happening somewhere around line 38:
Set rstIePa = dbPa.OpenRecordset(strGroupPASQL, dbOpenDynaset)
With rstIePa
If Not (.BOF And .EOF) Then
.MoveLast
lngTotRecCount = .RecordCount
.MoveFirst
Do While Not .EOF
Please see full code below. Any Help is appreciated!:
Option Compare Database
Option Explicit
Dim dbXL As DAO.Database
Dim strDate As String
Dim strGenl As String
Dim strTableName As String
Dim fld As DAO.Field
Dim strGroupPASQL As String
Dim strMakePaTablesSQL As String
Dim StrPaID As String
Dim strGenl2 As String
Dim strSupplier As String
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Function MakeTableVN()
DoCmd.SetWarnings False
Dim dbPa As DAO.Database
Dim rstIePa As DAO.Recordset
Dim lngTotRecCount As Long
Dim tdf As DAO.TableDef
Dim strADR_Name As String
Dim VN_Length As Double
DoCmd.OpenQuery "qryCreate_Local_Supplier_Contact_table"
DoCmd.OpenQuery "qryAdd_New_Vendors_to_tblSupplierContact"
'This query will add any new Vendors to the Rebate coordinator contact listing, so as to keep it up-to-date
DoCmd.OpenQuery "qryUpdate_Supplier_Contact_List"
'This query will match all vendor numbers to the Rebate ID to Vendor "rebate name" for consistency
'DoCmd.RunSQL "UPDATE [All Vendor Rebates] INNER JOIN [Rebate_ID-to_Vendor] ON [All Vendor Rebates].FirstOfVENDOR_NUM = [Rebate_ID-to_Vendor].Vendor SET [All Vendor Rebates].Vendor_Name = [Rebate_ID-to_Vendor]!Rebate_Name;"
Set dbPa = CurrentDb
'strGroupPASQL = "SELECT [all vendor rebates].Vendor_Name FROM [all vendor rebates] GROUP BY [all vendor rebates].Vendor_Name HAVING ((Not ([all vendor rebates].Vendor_Name)='CORNING GLASS (PIPET)' And Not ([all vendor rebates].Vendor_Name)='CORNING LIFE SCIENCES PLASTIC' And Not ([all vendor rebates].Vendor_Name)='CORNING LIFE SCIENCES' And Not ([All Vendor Rebates].Vendor_Name)='CORNING LIFE SCIENCES GLASS'));"
strGroupPASQL = "SELECT [all vendor rebates].Vendor_Name FROM [all vendor rebates] GROUP BY [all vendor rebates].Vendor_Name HAVING ((([all vendor rebates].Vendor_Name) Not Like 'CORNING*'));"
Set rstIePa = dbPa.OpenRecordset(strGroupPASQL, dbOpenDynaset)
With rstIePa
If Not (.BOF And .EOF) Then
.MoveLast
lngTotRecCount = .RecordCount
.MoveFirst
Do While Not .EOF
strSupplier = .Fields("Vendor_Name") & ""
strSupplier = Replace(strSupplier, ".", " ")
strSupplier = Replace(strSupplier, ":", " ")
strSupplier = Replace(strSupplier, "=", " ")
strSupplier = Replace(strSupplier, "/", " ")
strSupplier = Replace(strSupplier, "\", " ")
strSupplier = Replace(strSupplier, "'", "")
strSupplier = Replace(strSupplier, "*", " ")
strTableName = strSupplier
For Each tdf In dbPa.TableDefs
If tdf.Name = strTableName Then
dbPa.TableDefs.Delete tdf.Name
End If
Next
strMakePaTablesSQL = "SELECT Key_Code_Name, Vendor_Name, " _
& " Contract_ID, Exp_Date, Coordinator, Contract_Status, Price_Book into [" & strTableName & "] From [all vendor Rebates] Where Vendor_Name = '" & strSupplier & "'"
dbPa.Execute strMakePaTablesSQL
Debug.Print "C:\Testing\Expiring rebates\Vendor_Files\" & strSupplier & ".xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strTableName, "C:\Testing\Expiring rebates\Vendor_Files\" & strSupplier & ".xls", True
DoCmd.DeleteObject acTable, strTableName
'*********************************************************************************
Dim table_to_export, file_path_name, file_name As String
table_to_export = strTableName
file_path_name = "C:\Testing\Expiring rebates\Vendor_Files\" & strSupplier & ".xls"
file_name = strTableName & ".xls"
'******ZIP CODE********
Dim DefPath As String
Dim oApp As Object
Dim FileNameZip, FName
'location of file(s) that need zipped
DefPath = "C:\Testing\Expiring rebates\" & strSupplier
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
'file or folder that needs zipped
FName = "C:\Testing\Expiring rebates\Vendor_Files\" & strSupplier & ".xls"
'Name of zip file
FileNameZip = "C:\Testing\Expiring rebates\Vendor_Files\" & strSupplier & ".zip"
'Calls zip sub
NewZip (FileNameZip)
Set oApp = CreateObject("Shell.Application")
'Copy the files to the compressed folder
oApp.Namespace(FileNameZip).CopyHere FName
Sleep (10000)
'Call apWait(10)
Set oApp = Nothing
'*******EMAIL CODE********
'Email setup
Dim cnn1 As ADODB.Connection
Set cnn1 = CurrentProject.Connection
Dim get_email_address As New ADODB.Recordset
get_email_address.ActiveConnection = cnn1
Dim requester_email As String
Dim alt_requester_email As String
Dim alt2_requester_email As String
'Opens outlook object, assign object name of FirstOfEmail.....
get_email_address.Open "SELECT First(tblSupplier_Contact_Information.[Contact Email Address]) AS [FirstOfEmail name] FROM tblSupplier_Contact_Information WHERE (((tblSupplier_Contact_Information.[Rebate_Name]) = '" & rstIePa.Fields("Vendor_Name").Value & "')) "
'Checks for e-mail address if it cannot be found or is null then it is set to unknown
If get_email_address.EOF Then
requester_email = "Unknown"
ElseIf IsNull(get_email_address.Fields("FirstOfEmail name").Value) Then
requester_email = "Unknown"
Else: requester_email = get_email_address.Fields("FirstOfEmail name").Value
End If
get_email_address.Close
'Checks for alternate e-mail address
get_email_address.Open "SELECT First(tblSupplier_Contact_Information.[Second Contact Email Address]) AS [FirstOfEmail name] FROM tblSupplier_Contact_Information WHERE (((tblSupplier_Contact_Information.[Rebate_Name]) = '" & rstIePa.Fields("Vendor_Name").Value & "')) "
If get_email_address.EOF Then
alt_requester_email = "Unknown"
ElseIf IsNull(get_email_address.Fields("FirstOfEmail name").Value) Then
alt_requester_email = "Unknown"
Else: alt_requester_email = get_email_address.Fields("FirstOfEmail name").Value
End If
get_email_address.Close
'Checks for alternate e-mail address
get_email_address.Open "SELECT First(tblSupplier_Contact_Information.[Third Contact Email Address]) AS [FirstOfEmail name] FROM tblSupplier_Contact_Information WHERE (((tblSupplier_Contact_Information.[Rebate_Name]) = '" & rstIePa.Fields("Vendor_Name").Value & "')) "
If get_email_address.EOF Then
alt2_requester_email = "Unknown"
ElseIf IsNull(get_email_address.Fields("FirstOfEmail name").Value) Then
alt2_requester_email = "Unknown"
Else: alt2_requester_email = get_email_address.Fields("FirstOfEmail name").Value
End If
get_email_address.Close
'*****************************
Call send_email_notification_vendor(FileNameZip, requester_email, alt_requester_email, alt2_requester_email, strSupplier)
'Kill (file_path_name)
'***********************************************************************************
'GetExcel
.MoveNext
'Stop
Loop
End If
.Close
End With
'Call ExcludeCorning
ExitMakeTables:
Exit Function
End Function
Set rstIePa = dbPa.OpenRecordset(strGroupPASQL, dbOpenDynaset)
With rstIePa
If Not (.BOF And .EOF) Then
.MoveLast
lngTotRecCount = .RecordCount
.MoveFirst
Do While Not .EOF
Please see full code below. Any Help is appreciated!:
Option Compare Database
Option Explicit
Dim dbXL As DAO.Database
Dim strDate As String
Dim strGenl As String
Dim strTableName As String
Dim fld As DAO.Field
Dim strGroupPASQL As String
Dim strMakePaTablesSQL As String
Dim StrPaID As String
Dim strGenl2 As String
Dim strSupplier As String
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Public Function MakeTableVN()
DoCmd.SetWarnings False
Dim dbPa As DAO.Database
Dim rstIePa As DAO.Recordset
Dim lngTotRecCount As Long
Dim tdf As DAO.TableDef
Dim strADR_Name As String
Dim VN_Length As Double
DoCmd.OpenQuery "qryCreate_Local_Supplier_Contact_table"
DoCmd.OpenQuery "qryAdd_New_Vendors_to_tblSupplierContact"
'This query will add any new Vendors to the Rebate coordinator contact listing, so as to keep it up-to-date
DoCmd.OpenQuery "qryUpdate_Supplier_Contact_List"
'This query will match all vendor numbers to the Rebate ID to Vendor "rebate name" for consistency
'DoCmd.RunSQL "UPDATE [All Vendor Rebates] INNER JOIN [Rebate_ID-to_Vendor] ON [All Vendor Rebates].FirstOfVENDOR_NUM = [Rebate_ID-to_Vendor].Vendor SET [All Vendor Rebates].Vendor_Name = [Rebate_ID-to_Vendor]!Rebate_Name;"
Set dbPa = CurrentDb
'strGroupPASQL = "SELECT [all vendor rebates].Vendor_Name FROM [all vendor rebates] GROUP BY [all vendor rebates].Vendor_Name HAVING ((Not ([all vendor rebates].Vendor_Name)='CORNING GLASS (PIPET)' And Not ([all vendor rebates].Vendor_Name)='CORNING LIFE SCIENCES PLASTIC' And Not ([all vendor rebates].Vendor_Name)='CORNING LIFE SCIENCES' And Not ([All Vendor Rebates].Vendor_Name)='CORNING LIFE SCIENCES GLASS'));"
strGroupPASQL = "SELECT [all vendor rebates].Vendor_Name FROM [all vendor rebates] GROUP BY [all vendor rebates].Vendor_Name HAVING ((([all vendor rebates].Vendor_Name) Not Like 'CORNING*'));"
Set rstIePa = dbPa.OpenRecordset(strGroupPASQL, dbOpenDynaset)
With rstIePa
If Not (.BOF And .EOF) Then
.MoveLast
lngTotRecCount = .RecordCount
.MoveFirst
Do While Not .EOF
strSupplier = .Fields("Vendor_Name") & ""
strSupplier = Replace(strSupplier, ".", " ")
strSupplier = Replace(strSupplier, ":", " ")
strSupplier = Replace(strSupplier, "=", " ")
strSupplier = Replace(strSupplier, "/", " ")
strSupplier = Replace(strSupplier, "\", " ")
strSupplier = Replace(strSupplier, "'", "")
strSupplier = Replace(strSupplier, "*", " ")
strTableName = strSupplier
For Each tdf In dbPa.TableDefs
If tdf.Name = strTableName Then
dbPa.TableDefs.Delete tdf.Name
End If
Next
strMakePaTablesSQL = "SELECT Key_Code_Name, Vendor_Name, " _
& " Contract_ID, Exp_Date, Coordinator, Contract_Status, Price_Book into [" & strTableName & "] From [all vendor Rebates] Where Vendor_Name = '" & strSupplier & "'"
dbPa.Execute strMakePaTablesSQL
Debug.Print "C:\Testing\Expiring rebates\Vendor_Files\" & strSupplier & ".xls"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, strTableName, "C:\Testing\Expiring rebates\Vendor_Files\" & strSupplier & ".xls", True
DoCmd.DeleteObject acTable, strTableName
'*********************************************************************************
Dim table_to_export, file_path_name, file_name As String
table_to_export = strTableName
file_path_name = "C:\Testing\Expiring rebates\Vendor_Files\" & strSupplier & ".xls"
file_name = strTableName & ".xls"
'******ZIP CODE********
Dim DefPath As String
Dim oApp As Object
Dim FileNameZip, FName
'location of file(s) that need zipped
DefPath = "C:\Testing\Expiring rebates\" & strSupplier
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
'file or folder that needs zipped
FName = "C:\Testing\Expiring rebates\Vendor_Files\" & strSupplier & ".xls"
'Name of zip file
FileNameZip = "C:\Testing\Expiring rebates\Vendor_Files\" & strSupplier & ".zip"
'Calls zip sub
NewZip (FileNameZip)
Set oApp = CreateObject("Shell.Application")
'Copy the files to the compressed folder
oApp.Namespace(FileNameZip).CopyHere FName
Sleep (10000)
'Call apWait(10)
Set oApp = Nothing
'*******EMAIL CODE********
'Email setup
Dim cnn1 As ADODB.Connection
Set cnn1 = CurrentProject.Connection
Dim get_email_address As New ADODB.Recordset
get_email_address.ActiveConnection = cnn1
Dim requester_email As String
Dim alt_requester_email As String
Dim alt2_requester_email As String
'Opens outlook object, assign object name of FirstOfEmail.....
get_email_address.Open "SELECT First(tblSupplier_Contact_Information.[Contact Email Address]) AS [FirstOfEmail name] FROM tblSupplier_Contact_Information WHERE (((tblSupplier_Contact_Information.[Rebate_Name]) = '" & rstIePa.Fields("Vendor_Name").Value & "')) "
'Checks for e-mail address if it cannot be found or is null then it is set to unknown
If get_email_address.EOF Then
requester_email = "Unknown"
ElseIf IsNull(get_email_address.Fields("FirstOfEmail name").Value) Then
requester_email = "Unknown"
Else: requester_email = get_email_address.Fields("FirstOfEmail name").Value
End If
get_email_address.Close
'Checks for alternate e-mail address
get_email_address.Open "SELECT First(tblSupplier_Contact_Information.[Second Contact Email Address]) AS [FirstOfEmail name] FROM tblSupplier_Contact_Information WHERE (((tblSupplier_Contact_Information.[Rebate_Name]) = '" & rstIePa.Fields("Vendor_Name").Value & "')) "
If get_email_address.EOF Then
alt_requester_email = "Unknown"
ElseIf IsNull(get_email_address.Fields("FirstOfEmail name").Value) Then
alt_requester_email = "Unknown"
Else: alt_requester_email = get_email_address.Fields("FirstOfEmail name").Value
End If
get_email_address.Close
'Checks for alternate e-mail address
get_email_address.Open "SELECT First(tblSupplier_Contact_Information.[Third Contact Email Address]) AS [FirstOfEmail name] FROM tblSupplier_Contact_Information WHERE (((tblSupplier_Contact_Information.[Rebate_Name]) = '" & rstIePa.Fields("Vendor_Name").Value & "')) "
If get_email_address.EOF Then
alt2_requester_email = "Unknown"
ElseIf IsNull(get_email_address.Fields("FirstOfEmail name").Value) Then
alt2_requester_email = "Unknown"
Else: alt2_requester_email = get_email_address.Fields("FirstOfEmail name").Value
End If
get_email_address.Close
'*****************************
Call send_email_notification_vendor(FileNameZip, requester_email, alt_requester_email, alt2_requester_email, strSupplier)
'Kill (file_path_name)
'***********************************************************************************
'GetExcel
.MoveNext
'Stop
Loop
End If
.Close
End With
'Call ExcludeCorning
ExitMakeTables:
Exit Function
End Function
