MS Access 2003 Code to insert data into excel file corrupts file

[blacy]

The blow code was working fine but I must have screwed something up. All the sudden when you go to open the Excel file that I have copied, renamed, and inserted data into, the file will not open. No indications, it just does not open. If you look at the history in Excel it looks like ot was opended.

Everything else works. If I remove the "GetObject" code section the file will open so it seems to be isolated to this section. The problem is that I have not made any changes to this section of code but I have added and changed code before and after this section.

I am not that good so I need some help..

''''''''''''''''''
Private Sub Combo80_AfterUpdate()
On Error GoTo Err_Combo80_AfterUpdate
Dim strServerPath As String
Dim strNewDirectoryName As String
Dim strNewFullPathName As String
Dim strQuoteFormsPathName As String
Dim strQuoteFormsFileName As String
Dim strQuoteFormsFileName2 As String


strNewDirectoryName = Me![QuoteRef]

strServerPath = DLookup("QuoteFilePath", "ZZCompanyInfoTable1", "CompanyID= " & 1)

strNewFullPathName = strServerPath & strNewDirectoryName

strQuoteFormsPathName = DLookup("QuoteFormsPath", "ZZCompanyInfoTable1", "CompanyID= " & 1)

strQuoteFormsFileName = "CAPSQuote1.xls"
strQuoteFormsFileName2 = "AAA-PricingProgram(Q1).xls"


DoCmd.RunMacro "Quote Form Macros.Set Company"

MkDir strNewFullPathName

Me.QuoteFilePath = strNewFullPathName


'New
Dim fs As Object
Set fs = CreateObject("scripting.filesystemobject")
If fs.FileExists(strQuoteFormsPathName & strQuoteFormsFileName) Then
fs.CopyFile strQuoteFormsPathName & strQuoteFormsFileName, strNewFullPathName & "\" & strNewDirectoryName & "-1.xls", False
End If
Set fs = Nothing
'New

Dim fs2 As Object
Set fs2 = CreateObject("scripting.filesystemobject")
If fs2.FileExists(strQuoteFormsPathName & strQuoteFormsFileName2) Then
fs2.CopyFile strQuoteFormsPathName & strQuoteFormsFileName2, strNewFullPathName & "\" & strNewDirectoryName & "-2.xls", False
End If
Set fs2 = Nothing
'New
Me.Refresh


''''''''''''''''''''''''''''
Dim obj As Object
Set obj = GetObject(Me![QuoteFilePath] & "\" & strNewDirectoryName & "-1.XLS")
obj.Application.Visible = True
obj.ActiveSHeet.Range("Date") = Date
obj.ActiveSHeet.Range("Customer") =

obj.ActiveSHeet.Range("Address") =

obj.ActiveSHeet.Range("City_State_Zip") =

& ", " &

& " " &

obj.ActiveSHeet.Range("QuoteNumber") =

& "-" &

obj.ActiveSHeet.Range("JobName") =

& ", (" &

& ")"

obj.Save
Set obj = Nothing


Dim obj1 As Object
Set obj1 = GetObject(Me![QuoteFilePath] & "\" & strNewDirectoryName & "-2.XLS")
obj1.Application.Visible = True
obj1.ActiveSHeet.Range("QtRevDate") =

& "-" &

& ", " &

& ", " & Date
obj1.ActiveSHeet.Range("ProjName") =

& ", (" &

& ")"
obj1.ActiveSHeet.Range("Customer") =

obj1.ActiveSHeet.Range("By") =

obj1.Save
Set obj1 = Nothing


'Add new sub directory to the main folder
Dim strServerPathSub1 As String
Dim strNewDirectoryNameSub1 As String
Dim strNewFullPathNameSub1 As String

strNewDirectoryNameSub1 = Me![QuoteRef] & "(SpecReviewDocs)"
strServerPathSub1 = Me![QuoteFilePath] & "\"
strNewFullPathNameSub1 = strServerPathSub1 & strNewDirectoryNameSub1
MkDir strNewFullPathNameSub1

'Add new sub directory to the main folder
Dim strServerPathSub2 As String
Dim strNewDirectoryNameSub2 As String
Dim strNewFullPathNameSub2 As String

strNewDirectoryNameSub2 = Me![QuoteRef] & "(VendorRFQ-Quotes)"
strServerPathSub2 = Me![QuoteFilePath] & "\"
strNewFullPathNameSub2 = strServerPathSub2 & strNewDirectoryNameSub2
MkDir strNewFullPathNameSub2


Exit_Combo80_AfterUpdate:
Exit Sub

Err_Combo80_AfterUpdate:
MsgBox Err.Description

End Sub
''''''''''''''''''

 

[combo]

Make workbook's window visible:

Set obj = GetObject(Me![QuoteFilePath] & "\" & strNewDirectoryName & "-1.XLS")
obj.Windows(1).Visible = True

combo