Question

I have the following code:

set app = CreateObject("Excel.Application")
Set wb = app.Workbooks.Open("Y:\Billing_Common\autoemail\*.xls")

set sh = wb.Sheets("Auto Email Script")
row = 2
name = "Customer"
email = sh.Range("A" & row)
subject = "Billing"
the = "the"
LastRow = sh.UsedRange.Rows.Count

For r = row to LastRow
    If App.WorkSheetFunction.CountA(sh.Rows(r)) <> 0 Then 
        SendMessage email, name, subject, TRUE, _
        NULL, "Y:\Billing_Common\autoemail\Script\energia-logo.gif", 143,393
        row = row + 1
        email = sh.Range("A" & row)
    End if
Next
wb.close
set wb = nothing
set app = nothing


Sub SendMessage(EmailAddress, DisplayName, Subject, DisplayMsg, AttachmentPath, ImagePath, ImageHeight, ImageWidth)

  ' Create the Outlook session.
  Set objOutlook = CreateObject("Outlook.Application")

  template = FindTemplate()

  ' Create the message.
  Set objOutlookMsg  = objOutlook.CreateItem(0)

  With objOutlookMsg
      ' Add the To recipient(s) to the message.
      Set objOutlookRecip = .Recipients.Add(EmailAddress)
      objOutlookRecip.resolve
      objOutlookRecip.Type = 1

     ' Set the Subject, Body, and Importance of the message.
     .Subject = Subject
     .bodyformat = 3
     .Importance = 2  'High importance

     body = Replace(template, "{First}", name)
     body = Replace(body, "{the}", the)

     if not isNull(ImagePath) then
       if not ImagePath = "" then
         .Attachments.add ImagePath
         image = split(ImagePath,"\")(ubound(split(ImagePath,"\")))
         body = Replace(body, "{image}", "<img src='cid:" & image & _
         "'" & " height=" & ImageHeight &" width=" & ImageWidth & ">")
       end if
     else
        body = Replace(body, "{image}", "")
     end if

     if not isNull(AttachMentPath) then
       .Attachments.add AttachmentPath
     end if

     .HTMLBody = body
         .Save
         .Send
    End With
    Set objOutlook = Nothing
End Sub

Function FindTemplate()
    Set OL = GetObject("", "Outlook.Application")
    set Drafts = OL.GetNamespace("MAPI").GetDefaultFolder(16)
    Set oItems = Drafts.Items

    For Each Draft In oItems
        If Draft.subject = "Template" Then
            FindTemplate = Draft.HTMLBody
            Exit Function
        End If
    Next
End Function

It works fine when run off my local machine, but when run off Windows server it throws out an error at the line:

Set wb = app.Workbooks.Open("Y:\Billing_Common\autoemail\*.xls")

Saying it cannot find the file specified, the server has Office 2003 on it and I have ran out of ideas on why it's not working.

Any help would be much appreciated!

Thanks.

Was it helpful?

Solution

Most likely the Open method of Office 2003 doesn't support wildcards in the path. You'll have to enumerate the files in that folder:

Set app = CreateObject("Excel.Application")
Set fso = CreateObject("Scripting.FileSystemObject")

For Each f In fso.GetFolder("Y:\Billing_Common\autoemail").Files
  If LCase(fso.GetExtensionName(f)) = "xls" Then
    Set wb = app.Workbooks.Open(f.Path)
    ...
    wb.Close
  End If
Next
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top