Macros and Programming

I was given a macro by the wonderful Bert on here to do bulk emailing. It works like a dream on my computer, and a couple of others within this office. However, it does not work on two computers. Not sure if this is an OS issue, as it works on the computers running Windows 7 but not on the ones running XP or Vista.

The

Error message on computer running XP: "Command Failed. The specified module could not be found (8007007E). (Position in the macro - Line 45, Character 1)"

Error message on computer running Vista: "ActiveX Componant can't create object: (Outlook Application) (Position in the macro - Line 45, Character 1)".

The offending line in the macro is:

Set Outlook = CreateObject("Outlook.Application")

The full macro is:

'number of max addresses in bcc
maxmail = 40

'you can also pickup this here from a txt file. Do not forget that a vbcrlf or lf must be translated to <br>
emtxt = "Hi,<br><br>Your Message Goes Here."

'the subject of your mail
subj = "V4W"

dlg = GetOpenFilenames("All Files|*.*","","select files (use > 1 ctrl+click!)",cbxGetFilenamesWithPanel)
fles = split(dlg,vbcrlf)

set em = Records
for ct = 1 to em.count
     'add here as much as emailfields you want; have attention that emailaddresse must be correct spelled (no spaces in it!!)
     'only if in a field is an address is a line to x added.
     if em.item(ct).fields("EMAIL") <> "" then x = x & em.item(ct).fields("EMAIL") & vbcrlf
     if em.item(ct).fields("ORGEMAIL1") <> "" then x = x & em.item(ct).fields("ORGEMAIL1") & vbcrlf
     if em.item(ct).fields("ORGEMAIL2") <> "" then x = x & em.item(ct).fields("ORGEMAIL2") & vbcrlf
     if em.item(ct).fields("ORGEMAIL3") <> "" then x = x & em.item(ct).fields("ORGEMAIL3") & vbcrlf
     if em.item(ct).fields("ORGEMAIL4") <> "" then x = x & em.item(ct).fields("ORGEMAIL4") & vbcrlf
     if em.item(ct).fields("ORGEMAIL5") <> "" then x = x & em.item(ct).fields("ORGEMAIL5") & vbcrlf
     statustext = "Collecting addresses " & ct & "/" & em.count
next

'make an array of x
xm = split(x,vbcrlf)

'generate a email after 49 addresses
for ctr = 0 to Ubound(xm)
    addr = addr & xm(ctr) & vbcrlf
    i40 = i40 + 1
    if i40 = maxmail then
       fnc = makemail(addr)
       addr = ""
       i40 = 0
    end if
next

'the last addresses
fnc = makemail(addr)

'===================================================
function makemail(addr)
Set Outlook = CreateObject("Outlook.Application")
Set Msg = Outlook.CreateItem(0)
With Msg
     .To = "rochdalelink@voices4wellbeing.co.uk"
     .cc = ""
     .bcc = addr
     .Subject = subj
     .HTMLbody = emtxt
for each fle in fles
     .Attachments.Add fle
     next

     .Display
end with
end function

Wonderful that MicroSoft.

I remember I had the same on one XP Pro HP-pre-installed notebook ever.
Reinstalling MS Office did not help. So, I think the ActiveX registration did not correct itself while re-installing Outlook/MS Office.
I have spend a lot of hours to find out what caused this error. Never found.
I wanted to get it working without re-installing Windows. I was convinced it was already wrong in my pre-installed Windows version. So that could not help me.
 - not added yet).
So I developed a workaround then. The only limitation is that Outlook has to run when the macro is launched. (If it does not, some lines in the macro can check + launch it if necessary).

This is a what worked in my case:
Set Outlook = CreateObject("Outlook.Application")
on error resume next
Set Msg = Outlook.CreateItem(0)
if err.Number <> 0 then
    msgbox "Create Outlook object failed" 'you can remark this line if you see that the workaround works
    on error goto 0
    set outlook = nothing
    Set WshShell = CreateObject("WScript.Shell")
    WshShell.Run "outlook", 2
    Set Outlookk = CreateObject("Outlook.Application")
    Set Msg = Outlookk.CreateItem(0) 'olMailItem=0)
end if
on error goto 0

.....

I Hope this will help you.

regards
bert

Thank you very much for your help bert, but I am still getting the same error messages.

I changed my macro so the end looks like this:

'the last addresses
fnc = makemail(addr)

'===================================================
function makemail(addr)
Set Outlook = CreateObject("Outlook.Application")
on error resume next
Set Msg = Outlook.CreateItem(0)
if err.Number <> 0 then
    msgbox "Create Outlook object failed" 'you can remark this line if you see that the workaround works
    on error goto 0
    set outlook = nothing
    Set WshShell = CreateObject("WScript.Shell")
    WshShell.Run "outlook", 2
    Set Outlookk = CreateObject("Outlook.Application")
    Set Msg = Outlookk.CreateItem(0) 'olMailItem=0)
end if
on error goto 0

With Msg
     .To = "rochdalelink@voices4wellbeing.co.uk"
     .cc = ""
     .bcc = addr
     .Subject = subj
     .HTMLbody = emtxt
for each fle in fles
     .Attachments.Add fle
     next

     .Display
end with
end function

It still says the error is the Set Outlook = CreateObject("Outlook.Application")line