Email Attachments work in access 2003, fail in 2007/2010

[Gainaxe]

I have some VBA code that sends automatic emails with different attachments for each email. It works perfectly when run in access 2003, however anytime I run it in access 2007 or 2010 the first attachment gets sent on every single email(the body changes, the attachment does not). I have been pulling my hair out trying to figure out why. Code Pasted below;
The code to create attachments

Option Compare Database
Function ExportFeeWithoutApprovalReports()
Dim DB As Database
Dim rs As Recordset
Dim RS1 As Recordset
Dim objQR As QueryDef
Dim txtCurDir As String
Dim txtSQL As String
Dim txtSQL2 As String
Dim txtName As String
Dim txtSQLFilterField As String
Dim lngStrReturn As Long
Dim Quote
Dim TheDate
Quote = Chr(34)
Dim strfinaldir As String
Dim strBody As String
Dim strEmail As String
Dim strEmailAdd As String
Dim blnEmailGood() As Boolean
Dim blnEmailGd As Boolean
Dim pintCount As Integer
Dim pintCounting As Integer
Dim pintCounter As Integer
Dim pintCounted As Integer
Dim txtOpsCntr As String
Dim strLarN As String
Dim strTo As String
Dim strCC As String

On Error GoTo ExportError

strfinaldir = "Fee Without Approval"
txtCurDir = "****"

Set DB = DBEngine.Workspaces(0).Databases(0)
Set rs = DB.OpenRecordset("SELECT DISTINCT [Name],[PCN] FROM tblFeeWithoutApprovalInformation")
rs.MoveFirst
If rs.EOF = True Then
MsgBox "No Fee Without Approval to Report"
Exit Function
End If
TheDate = Format((Date), "mmm dd yyyy")

Do
txtName = rs.Fields("Name").Value
txtPCN = rs.Fields("PCN").Value

strQSQL = "SELECT [InvoiceNumber], [AgreementNumber], [SalesLocationName], [ContractTypeName], [OperationsCenterCode], [PurchaseOrderNumber], [PurchaseOrderTypeCode], [PCN], [Name], [InvoiceAmount], [InvoiceCurrencyCode], [FeeLevelCode] as 'Fee Level', [InvoiceCreatedDate]"
strQSQL = strQSQL & " FROM tblFeeWithoutApprovalInformation WHERE [Name] = " & Quote & txtName & Quote & " ;"
Set objQR = DB.CreateQueryDef("FeeWithoutApproval_Query", strQSQL)
strFilenameXLS = "*****" & txtName & " (Fee Without Approval - " & TheDate & ")" & ".xls"
DoCmd.OutputTo acOutputQuery, "FeeWithoutApproval_Query", acFormatXLS, strFilenameXLS, 0
strAttachfiles = strFilenameXLS

'Place email information here
'Check for Spanish
If checkLanguageCode(txtPCN) = "SP" And checkRegionCode(txtESAPCN) <> "North America" Then
strBody = "Fecha del Reporte: " & Date & "<BR><BR>"
strBody = strBody & "Estimado,<BR><BR>"
strBody = strBody & "El reporte mencionado señala los reportes de honorarios que se les ha enviado, y que esperan la aprobación por parte suya.<BR><BR>"
'Check for Portuguese
ElseIf checkLanguageCode(txtPCN) = "PO" And checkRegionCode(txtESAPCN) <> "North America" Then
strBody = "Data do relatório: " & Date & "<BR><BR>"
strBody = strBody & "Estimado,<BR><BR>"
strBody = strBody & "O relatório de honorários do, que requer sua aprovação, se encontra em anexo.<BR><BR>"

'Check for North America
ElseIf checkLanguageCode(txtPCN) <> "PO" And checkLanguageCode(txtESAPCN) <> "SP" And checkRegionCode(txtESAPCN) = "North America" Then

strBody = "Report Date: " & Date & "<BR><BR>"
strBody = strBody & "Attached is your Fee Without Approval Report.<BR><BR>"

Else

strBody = "Report Date: " & Date & "<BR><BR>"
strBody = strBody & "Attached is your Fee Without Approval Report.<BR><BR>"

End If

'Get the Partner's Email Address. If it does not exist, use gblstrEmlAdmin.
strTo = checkAddress(txtPCN, gblstrEmlAnalyst)
'Get the COM's or CAM's Email Address. If it does not exist, use nothing.
strCC = checkCAMCOM(txtPCN)
Call EmailAll(strAttachfiles, strTo, strCC, strfinaldir, strBody)
DB.QueryDefs.Delete objQR.Name
rs.MoveNext
If gblTestMode = 1 Then Exit Do
Loop Until rs.EOF = True
rs.Close
Set rs = Nothing


The code that emails attachments(please note the schemas use http but cannot post links yet)
Sub EmailAll(strAttachments, strTo, strCC, strSubject, strBody)

Dim strEmlAdmin As String
Dim strAddress As String
Dim strFrom As String
Dim objMsg
If gblTestMode = 0 Then
strEmlAdmin = gblstrEmlAdmin
If Trim(strTo & "") <> "" Then
strAddress = strTo
Else
strAddress = gblstrEmlAdmin
End If
strFrom = "****"
Else
strEmlAdmin = gblstrEmlTest
strAddress = gblstrEmlTest
strFrom = gblstrEmlTest
End If
Set objMsg = CreateObject("CDO.Message")
With objMsg
.from = strFrom
.To = strAddress
.cc = strCC
.BCC = strEmlAdmin
If strAddress = strEmlAdmin Then
objMsg.Subject = "Undeliverable " & strSubject
Else
objMsg.Subject = strSubject
End If
.HTMLBody = strBody

'strAttArray = Split(strAttachments, "|")
'For i = 0 To UBound(strAttArray)
.addattachment strAttachments 'strAttArray(i)
'Next
.Configuration.Fields.Item
Sub EmailAll(strAttachments, strTo, strCC, strSubject, strBody)

Dim strEmlAdmin As String
Dim strAddress As String
Dim strFrom As String
Dim objMsg
If gblTestMode = 0 Then
strEmlAdmin = gblstrEmlAdmin
If Trim(strTo & "") <> "" Then
strAddress = strTo
Else
strAddress = gblstrEmlAdmin
End If
strFrom = "****"
Else
strEmlAdmin = gblstrEmlTest
strAddress = gblstrEmlTest
strFrom = gblstrEmlTest
End If
Set objMsg = CreateObject("CDO.Message")
With objMsg
.from = strFrom
.To = strAddress
.cc = strCC
.BCC = strEmlAdmin
If strAddress = strEmlAdmin Then
objMsg.Subject = "Undeliverable " & strSubject
Else
objMsg.Subject = strSubject
End If
.HTMLBody = strBody

'strAttArray = Split(strAttachments, "|")
'For i = 0 To UBound(strAttArray)
.addattachment strAttachments 'strAttArray(i)
'Next
.Configuration.Fields.Item("//schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Configuration.Fields.Item("//schemas.microsoft.com/cdo/configuration/smtpserver") = "smtphost"
.Configuration.Fields.Item("//schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Configuration.Fields.Item("//schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 2
.Configuration.Fields.Update
.Send
End With
Set objMsg = Nothing
End Sub
.Configuration.Fields.Update
.Send
End With
Set objMsg = Nothing
End Sub

[OBP]

This "strAttachfiles" does not match this "strAttachmentstch" namewise. So I would put in a messagebox after this line
strAttachfiles = strFilenameXLS

msgbox strAttachfiles & “ “ & strFilenameXLS

and another one before this line in the emailing Procedure
.addattachment strAttachments 'strAttArray(i)

msgbox strAttachments


To establish that a, the Excle name gets transferred to the strAttachfiles string and that the strAttachfiles gets transferred to the strAttachments string during the change of Procedure.

[Gainaxe]

I tested the above suggestion and can confirm that the excel name is being passed forward into the emailing function(with the entire path included).

The problem I seem to be having is the first string is being passed, but the second time around it still is passing the first string along(so for example if the fire filename was \testserver\test\testfile1.xls the second time around it will \testserver\test\testfile1.xls instead of \testserver\test\testfile2.xls ).

Any insight into this issue would be appreciated. I inhertited this database from a previous programmer and while I can make sense of some of it there are still some things that are confusing

[OBP]

So is the testfile1.xls being incremented to testfile2.xls?
I don't see anything on the line that is being incremented

strFilenameXLS = "*****" & txtName & " (Fee Without Approval - " & TheDate & ")" & ".xls"

TheDate should be changing the File name, however more than operation on the same day will not change the file name unless you include the time as well.