Help with VBScript email wild card attachment

I have automated excel reports that generate each day and are placed in a specific folder on my network.  I have a VBScript that I use to email these reports automatically. The files names are the names of the users who get the report with the exception there is a random number as part of the file name.  So the file name changes partially each day.  How can I add a wildcard script to attach the file based only on the user name in the file name?  My current script is only looking for a specific file name.  Here is my script.

Set objMessage = CreateObject("CDO.Message")

HTMLMessage = "Reports Attached"

objMessage.Subject = "XXX Reports"
'objMessage.Sender = "John Doe"
objMessage.From = "Doe"
objMessage.To = "email@business.com"
objMessage.HTMLBody = HTMLMessage
objMessage.AddAttachment "c:\temp\1234johndoe@business.com.xls"
objMessage.Send
filbunkAsked:
Who is Participating?
 
Chris BottomleyConnect With a Mentor Software Quality Lead EngineerCommented:
Added a msgbox to temporarily see what is being returned. ... assuming the file name is correct then let it continue and what happens?

Chris
Set objMessage = CreateObject("CDO.Message")

HTMLMessage = "Reports Attached"

objMessage.Subject = " Reports"
'objMessage.Sender = "xxxx xxxxr"
objMessage.From = "Hxxx"
objMessage.To = "john.doer@business.com"
objMessage.HTMLBody = HTMLMessage
strFile = cstr(findfile("c:\temp","johndoe@business.com.xls"))
MsgBox strfile
objMessage.AddAttachment strfile
objMessage.Send
Function findfile(strFolder, strFileName)
Dim fso
Dim fil
Dim ver

    Set fso = CreateObject("scripting.filesystemobject")
	On Error Resume next
    For Each fil In fso.getfolder(strFolder).Files
        ver = Replace(fil.Name, strFileName, "", 1, , 1)
        If LCase(Mid(fil.Name, 5)) = LCase(strFileName) And IsNumeric(ver) Then
            If fil.Path > findfile Then _
                findfile = fil.Path
        End If
    Next
End Function

Open in new window

0
 
Bill PrewCommented:
Will there be multiple files for the same user, with different random numbers?  If so, how will you know which one needs to be mailed?

~bp
0
 
filbunkAuthor Commented:
Some users will have multiple files but most will only have one file.  Each user is the same every day.  The file is named something like this "12345johndoe@business.com.xls.  The next day the file for this user is named "64758johndoe@business.com.xls.  Once the files have been distributed each day, I clear out the directory and it is empty for the next day's reports.  Does this make sense?
0
Cloud Class® Course: Microsoft Exchange Server

The MCTS: Microsoft Exchange Server 2010 certification validates your skills in supporting the maintenance and administration of the Exchange servers in an enterprise environment. Learn everything you need to know with this course.

 
Chris BottomleySoftware Quality Lead EngineerCommented:
Assuming there is only one file then try adding a funtion for example add the function below then use:


objMessage.AddAttachment findfile("c:\temp", "johndoe@business.com.xls")
instead of
objMessage.AddAttachment "c:\temp\1234johndoe@business.com.xls"

Chris
Function findfile(strFolder, strFileName)
Dim fso
Dim fil

    Set fso = CreateObject("scripting.filesystemobject")
    For Each fil In fso.getfolder(strFolder).Files
        If LCase(fil.Name) Like "*" & strFileName Then
            findfile = fil.Path
        End If
    Next
End Function

Open in new window

0
 
Chris BottomleySoftware Quality Lead EngineerCommented:
Forgot a line to improve efficiency!

Chris
Function findfile(strFolder, strFileName)
Dim fso
Dim fil

    Set fso = CreateObject("scripting.filesystemobject")
    For Each fil In fso.getfolder(strFolder).Files
        If LCase(fil.Name) Like "*" & strFileName Then
            findfile = fil.Path
            Exit For
        End If
    Next
End Function

Open in new window

0
 
Chris BottomleySoftware Quality Lead EngineerCommented:
Tweaking it a bit to allow for multiple similarly named files means:

Note same name so the call is the same but now it returns the file with the 'highest name rather than the first file found.

note 125johndoe@business.com.xls
>
1233johndoe@business.com.xls"

but
1234johndoe@business.com.xls"
>
1233johndoe@business.com.xls"

Chris
Function findfile(strFolder, strFileName)
Dim fso
Dim fil

    Set fso = CreateObject("scripting.filesystemobject")
    For Each fil In fso.getfolder(strFolder).Files
        If LCase(fil.Name) Like "*" & strFileName Then
            If fil.Path > findfile Then _
                findfile = fil.Path
        End If
    Next
End Function

Open in new window

0
 
Bill PrewCommented:
A risk I see with Chris's approach is false substring matches.  It may not be an issue in your environment today, but be aware that if you had usernames of:

bsmith@business.com
absmith@business.com

then when searching for "bsmith@business.com" either would be a valid match, so you could pick up the wrong file.

If the random number if always left justified and the same number of positions then you might consider removing it before the test, rather than the wildcard approach, as in:

Function findfile(strFolder, strFileName)
Dim fso, fil
    Set fso = CreateObject("scripting.filesystemobject")
    For Each fil In fso.getfolder(strFolder).Files
        If LCase(Mid(fil.Name, 5)) = LCase(strFileName) Then
            findfile = fil.Path
            Exit For
        End If
    Next
End Function

Open in new window

~bp
0
 
filbunkAuthor Commented:
I have very few users and the full user name is always in the file name so I don't think there will be an issue in my environment for picking up the wrong file.  You both have helped me tremendously.  I am not a VB scripter, merely just an admin trying to make things more efficient for my network.  Can you guide me as to what I need to fill in for the above examples?  In other words, where in these scripts do I insert my network, file or user information?
0
 
Chris BottomleySoftware Quality Lead EngineerCommented:
The following is improved to allow for the risk Bill identified and to cater for multiple files at the time i.e. it's morre resilient.  It is called as I said above by:

using the line
objMessage.AddAttachment findfile("c:\temp", "johndoe@business.com.xls")
instead of
objMessage.AddAttachment "c:\temp\1234johndoe@business.com.xls"

Function findfile(strFolder, strFileName)
Dim fso
Dim fil
Dim ver

    Set fso = CreateObject("scripting.filesystemobject")
    For Each fil In fso.getfolder(strFolder).Files
        ver = Replace(fil.Name, strFileName, "", 1, , 1)
        If LCase(Mid(fil.Name, 5)) = LCase(strFileName) And IsNumeric(ver) Then
            If fil.Path > findfile Then _
                findfile = fil.Path
        End If
    Next
End Function

Open in new window

0
 
filbunkAuthor Commented:
Ok...I compiled the script but got the following error:  <18,9> Microsoft VBScript runtime error: Type mismatch.  Here is the script.  Any suggestions?




Set objMessage = CreateObject("CDO.Message")

HTMLMessage = "Reports Attached"

objMessage.Subject = " Reports"
'objMessage.Sender = "xxxx xxxxr"
objMessage.From = "Hxxx"
objMessage.To = "john.doer@business.com"
objMessage.HTMLBody = HTMLMessage
objMessage.AddAttachment findfile("c:\temp","xxxx.xxxx@business.com.xls")
Function findfile(strFolder, strFileName)
Dim fso
Dim fil
Dim ver

    Set fso = CreateObject("scripting.filesystemobject")
    For Each fil In fso.getfolder(strFolder).Files
        ver = Replace(fil.Name, strFileName, "", 1, , 1)
        If LCase(Mid(fil.Name, 5)) = LCase(strFileName) And IsNumeric(ver) Then
            If fil.Path > findfile Then _
                findfile = fil.Path
        End If
    Next
End Function
objMailItem.Send
0
 
Chris BottomleySoftware Quality Lead EngineerCommented:
Apologies it errors out when the string is not found ... see below for that correction:

Chris
Function findfile(strFolder, strFileName)
Dim fso
Dim fil
Dim ver

    Set fso = CreateObject("scripting.filesystemobject")
    On Error Resume next
    For Each fil In fso.getfolder(strFolder).Files
        ver = Replace(fil.Name, strFileName, "", 1, , 1)
        If LCase(Mid(fil.Name, 5)) = LCase(strFileName) And IsNumeric(ver) Then
            If fil.Path > findfile Then _
                findfile = fil.Path
        End If
    Next
End Function

Open in new window

0
 
filbunkAuthor Commented:
Well the script worked and I received the email but the attachment was not the file.  The attachment was an empty .dat file. ???
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.