Hi,
I am getting the same ERROR massage for the below code.
Please help in it.
open_db1
open_db2
'str_key = "SELECT distinct " & str_Query_MailBody & " FROM [MasterData_Domestic_5284$] where " & str_key & "=" & key_data(i)
keylist1 = Fetch_keylist2(str_key)
keycount1 = UBound(VBA.Split(keylist1, ",")) + 1
key_data1 = VBA.Split(keylist1, ",")
For i = 0 To keycount1 - 1
strSql = "SELECT " & str_Query_MailBody & " FROM [MasterData_Domestic_5284$] where " & str_key & "=" & key_data1(i)
Set rs1 = db1.OpenRecordset(strSql)
If rs1 Is Nothing Then
MsgBox "Error in All Fails data fetch!", vbExclamation, ThisWorkbook.Name
Exit Sub
End If
'To Form the page and header
rs1.MoveFirst
rs1.MoveLast
reccount = rs1.RecordCount
rs1.MoveFirst
str = ""
If (Not rs1.EOF) Then
' str_MailTo = rs1(str_MailTo) & ""
str_MailCc = rs1(str_MailCc) & ""
'str_MailBCc = rs1(str_MailBCc) & ""
' str_MailAddressTo = rs1(str_MailAddressTo) & ""
'str_MailAddressTo1 = str_MailAddressTo
'For Each fld In rs1.Fields
' str_MailAddressTo1 = Replace(str_MailAddressTo1, "[" & fld.Name & "]", rs1(fld.Name))
' Next
str_attachmentFile1 = str_attachmentFile
For Each fld In rs1.Fields
str_attachmentFile1 = Replace(str_attachmentFile1, "[" & fld.Name & "]", rs1(fld.Name))
Next
str_Subject1 = str_Subject
For Each fld In rs1.Fields
str_Subject1 = Replace(str_Subject1, "[" & fld.Name & "]", rs1(fld.Name))
Next
str_MailAddressTo1 = str_MailAddressTo
For Each fld In rs1.Fields
str_MailAddressTo1 = Replace(str_MailAddressTo1, "[" & fld.Name & "]", rs1(fld.Name))
Next
str_MailBody1_1 = str_MailBody1
For Each fld In rs1.Fields
str_MailBody1_1 = Replace(str_MailBody1_1, "[" & fld.Name & "]", rs1(fld.Name))
Next
str_MailBody2_1 = str_MailBody2
For Each fld In rs1.Fields
str_MailBody2_1 = Replace(str_MailBody2_1, "[" & fld.Name & "]", rs1(fld.Name))
Next
For Each fld In rs1.Fields
'for customized signature (MANOJ)
SigString = "C:\Documents and Settings\" & Environ("username") & _
"\Application Data\Microsoft\Signatures\Signature.txt"
'for customized signature (MANOJ)
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
Next
End If
' rs1.Close
' Set rs1 = Nothing
strsq2 = "SELECT " & str_Query_MailBody2 & " FROM [ContactList_Domestic_5284$] where " & str_key & "=" & key_data1(i)
Set rs2 = db2.OpenRecordset(strsq2) 'added by MANOJ for ContactList_International
If rs2 Is Nothing Then
MsgBox "Error in Fetching MailBody Data!", vbExclamation, ThisWorkbook.Name
Exit Sub
End If
'To Form the page and header
rs2.MoveFirst
rs2.MoveLast
reccount = rs2.RecordCount
rs2.MoveFirst
str = ""
If (Not rs2.EOF) Then
str_MailTo = rs1(str_MailTo) & ""
str_MailTo1 = str_MailTo
For Each fld In rs2.Fields
str_MailTo1 = Replace(str_MailTo, "[" & fld.Name & "]", rs2(fld.Name))
str_MailTo1 = rs2(str_MailTo) & ""
Next
Else
str_MailTo1 = "" 'added by MANOJ for ContactList_International uniqueness
End If
str_MailAddressTo = rs1(str_MailAddressTo) & ""
str_MailAddressTo1 = str_MailAddressTo
For Each fld In rs2.Fields
str_MailAddressTo1 = Replace(str_MailAddressTo1, "[" & fld.Name & "]", rs2(fld.Name))
rs2.Close
Set rs2 = Nothing
'rs1.Close
'Set rs1 = Nothing
Form_mail str_MailAddressTo1 & str_MailBody1_1 & Signature, str_content, str_MailAddressTo1 & str_MailBody2_1 & Signature, str_attachmentFile1, str_MailTo1, str_MailCc, str_MailFrom, str_MailAddressTo1
rs1.MoveNext
Next i
rs1.Close
Set rs1 = Nothing
close_db2 'added by MANOJ for ContactList_International close
close_db1