B
beancurdjelly2003
I already test my marco at home, it work. But in Office, cannot send
out and shown error message "Run-time error '-2147220960 (80040220)'
The "SendUsing" configuration value is invalid."
Office is use "MS exchange", don't know how do set the code for loggin
user name/password (because i have 2 email account).
below is sample it work at home "SMTP"
Sub Send()
myMsg = "Send out email Now?"
myTitle = "Send out"
myBtn = MsgBox(myMsg, vbOKCancel + vbExclamation, myTitle)
If myBtn = 1 Then
'Working in 2000-2007
Dim iMsg As Object
Dim iConf As Object
Dim sh As Worksheet
Dim cell As Range, FileCell As Range, rng As Range
' Dim Flds As Variant
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Lookup")
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
For Each cell In
sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
If Val(Application.Version) >= 12 Then
If wb.FileFormat = 51 And wb.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file, there will be
no VBA code in the file you send." & vbNewLine & _
"Save the file first as xlsm and then try the macro
again.", vbInformation
Exit Sub
End If
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
' .Item("http://schemas.microsoft.com/cdo/configuration/
sendusing") = 2
' .Item("http://schemas.microsoft.com/cdo/configuration/
smtpserver") = "smtpo.hkbn.net"
' .Item("http://schemas.microsoft.com/cdo/configuration/
smtpserverport") = 25
' .Update
' End With
With iMsg
Set .Configuration = iConf
.To = cell.Value
.BCC = ""
.Subject = cell.Offset(0, -1).Value & " SmarTone-Vodafone
Bill" & " - " & Format(Now, "mmmm yy")
.TextBody = "Dear Customer," & vbNewLine & vbNewLine & _
"Please contact us on or before " & Format(Now,
"mmmm")
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.AddAttachment FileCell.Value
End If
End If
Next FileCell
.Send 'Or use Display
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End If
End Sub
out and shown error message "Run-time error '-2147220960 (80040220)'
The "SendUsing" configuration value is invalid."
Office is use "MS exchange", don't know how do set the code for loggin
user name/password (because i have 2 email account).
below is sample it work at home "SMTP"
Sub Send()
myMsg = "Send out email Now?"
myTitle = "Send out"
myBtn = MsgBox(myMsg, vbOKCancel + vbExclamation, myTitle)
If myBtn = 1 Then
'Working in 2000-2007
Dim iMsg As Object
Dim iConf As Object
Dim sh As Worksheet
Dim cell As Range, FileCell As Range, rng As Range
' Dim Flds As Variant
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set sh = Sheets("Lookup")
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
For Each cell In
sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
'Enter the file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")
If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) > 0 Then
Set OutMail = OutApp.CreateItem(0)
If Val(Application.Version) >= 12 Then
If wb.FileFormat = 51 And wb.HasVBProject = True Then
MsgBox "There is VBA code in this xlsx file, there will be
no VBA code in the file you send." & vbNewLine & _
"Save the file first as xlsm and then try the macro
again.", vbInformation
Exit Sub
End If
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
' .Item("http://schemas.microsoft.com/cdo/configuration/
sendusing") = 2
' .Item("http://schemas.microsoft.com/cdo/configuration/
smtpserver") = "smtpo.hkbn.net"
' .Item("http://schemas.microsoft.com/cdo/configuration/
smtpserverport") = 25
' .Update
' End With
With iMsg
Set .Configuration = iConf
.To = cell.Value
.BCC = ""
.Subject = cell.Offset(0, -1).Value & " SmarTone-Vodafone
Bill" & " - " & Format(Now, "mmmm yy")
.TextBody = "Dear Customer," & vbNewLine & vbNewLine & _
"Please contact us on or before " & Format(Now,
"mmmm")
For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) <> "" Then
If Dir(FileCell.Value) <> "" Then
.AddAttachment FileCell.Value
End If
End If
Next FileCell
.Send 'Or use Display
End With
Set OutMail = Nothing
End If
Next cell
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End If
End Sub