Need VBA help sending data to an excel sheet from Access 2007 code

[Punice]

I asked for help about 2 weeks ago, received some help,but no solution to my problem. So, I trying another approach.

I have a control on a 'L_Name' customer's form, in an Access 2007 DB, that copies a template Excel file (ie., SOM.xlsx), renames it to 'L_Name SOM.xlsx) and fills it with customer name, address, etc., which is obtained from the customer's form.

While L_Name SOM.xlsx file is open, I want to open from another xlsx file (ie, L:_Name Roof.xlsx) and & copy cell "M59"s value from it & paste it into cell "E14" on the L_Name SOM.xlsx, initially.x). I know....WHEW!

Private Sub SOMCreate_Label_Click()
Dim appExcel As excel.Application
Dim lngLastDataRow As Long
Dim Folder_Path As String
Dim strFolder_PathNew As String
Dim strTotMatlCost As String
Dim WkBk As excel.Workbook
Dim MatlCost As String

'Get the folder name for this business year's database
GetDBPath = CurrentProject.Path 'Like: "C:\11_R11_TY-18
strSourceFolder = GetDBPath 'Like: "C:\11_R11_TY-18

'Create path for customer folder & files
strFolder_Path = strSourceFolder & "" & "Marketing" & (Me.[L_Name])

'Check for existing directory with the current form's customer name.
If Dir(strFolder_Path, vbDirectory) = "" Then
MsgBox ("Ok to create folder!"), vbOKCancel = vbOK
MkDir strFolder_Path
'The name entered into the 'L_Name' window of the "Customers" form.
Else
MsgBox "The folder already exists.", vbOKOnly

'Creates the path to and fullname of the SOM file for the current customer
strFolder_PathNew = strFolder_Path & "" & Me.[L_Name] & " SOM" & ".xlsx"

If Len(Dir(strFolder_PathNew)) = 0 Then
'Copies the blank model "SOM.xlsx" to the 'L_Name' folder & renames it 'L_Name SOM.xlsx'.
FileCopy strSourceFolder & "" & "SOM.xlsx", strFolder_PathNew
Response = MsgBox(Me.[L_Name] & " SOM", vbOKOnly)

Set appExcel = CreateObject("Excel.Application")
With appExcel
.Visible = True
.UserControl = True

'Open the renamed 'SOM.xlsx' file in the associated folder & enter the 'Me.[data] into it.
With .Workbooks.Open(strFolder_PathNew)
lngLastDataRow = .Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row
.Worksheets("Sheet1").Range("D2") = Me.[Cust_No]
.Worksheets("Sheet1").Range("D4") = Me.[F_Name] & " " & Me.[L_Name]
.Worksheets("Sheet1").Range("D5") = Me.[Address]
.Worksheets("Sheet1").Range("D6") = Me.[City] & ", " & Me.[State] & " " & Me![ZipCode]
.Worksheets("Sheet1").Range("D8") = Me.[Phone_No]
.Worksheets("Sheet1").Range("D9") = Me.[Cell_No]
.Worksheets("Sheet1").Range("D10") = Me.[Work_No]
.Worksheets("Sheet1").Range("D11") = Me.
End With
End With

appExcel.WindowState = xlMaximized

Else
MsgBox "The file has already exists. Use 'Edit SOM' to make changes.", vbOKOnly
End If
End If

'THE ABOVE CODE WORK GREAT, THANKS TO THIS FORUM!!!

'Gets the value in cell 'M59' from the closed 'L_Name Roof.xlsx (bidder) file & assigns it to 'MatlCost'
strFolder_PathNew = strFolder_Path & "\" & Me.[L_Name] & " Roof" & ".xlsx"
Set appExcel = CreateObject("Excel.Application")
Set WkBk = appExcel.Workbooks.Open(strFolder_PathNew)
MatlCost = WkBk.Sheets(1).Range("M59").Value

'AND, THE ABOVE CODE DOES, AS WELL.

'Closes the 'L_Name Roof.xlsx' BUT LEAVES AN EXCEL BLUE SCREEN DISPLAYIG
WkBk.Close True
appExcel.Quit
Set appExcel = Nothing


'THE FOLLOING CODE DOESN'T WRITE THE 'MATLCOST'S VALUE INTO 'E14' OF THE open 'L_Name SOM.xlsx' worksheet
Dim wb As Workbook
Dim ws As Worksheet

Set wb = ActiveWorkbook
Set ws = wb.Sheets("Sheet1") 'SOMETIMES REPORTS "OBJECT VARIABLE NOT SET".

Set DstnCost = ws.Range("E14")
DstnCost.Value = "MatlCost" 'WRITES "MatlCost" TO CELL 'E14', INITIALY; THEN, NOTHING
'WHEN SUB IS RE-RUN AFTER DELETING THE 'l_Name SOM.xlsx'
'THAT WAS SAVE.
'Closes & saves the 'L_Name SOM.xlsx'
wb.Close True

End Sub

 

[Gasman]

What is your error?
I don't think you need to set the Excel object again, you already have that, just open another workbook.
As I think I mentioned in the other thread, walk through the code line by line with F8 and the debug window and inspect each variable.
And if you still can't get it to work, what is wrong with a formula that references the other workbook, if it is always going to be the same cell value.?

 

[JHB]

I think the fault is that you SET the appExcel for two different Excel file.
So you could try the below code, it is not tested so maybe there are some error in it, (if you can't get it post your database and the two Excel file, zip it).
The code can be optimized!
Change code is red.

Private Sub SOMCreate_Label_Click()
Dim appExcel As excel.Application
[B][COLOR=Red]Dim appExcelRoof As excel.Application
[/COLOR][/B]Dim lngLastDataRow As Long
Dim Folder_Path As String
Dim strFolder_PathNew As String
Dim strTotMatlCost As String
Dim WkBk As excel.Workbook
Dim MatlCost As String

'Get the folder name for this business year's database
GetDBPath = CurrentProject.Path 'Like: "C:\11_R11_TY-18
strSourceFolder = GetDBPath 'Like: "C:\11_R11_TY-18

'Create path for customer folder & files
strFolder_Path = strSourceFolder & "" & "Marketing" & (Me.[L_Name])

'Check for existing directory with the current form's customer name.
If Dir(strFolder_Path, vbDirectory) = "" Then
MsgBox ("Ok to create folder!"), vbOKCancel = vbOK
MkDir strFolder_Path
'The name entered into the 'L_Name' window of the "Customers" form.
Else
MsgBox "The folder already exists.", vbOKOnly

'Creates the path to and fullname of the SOM file for the current customer
strFolder_PathNew = strFolder_Path & "" & Me.[L_Name] & " SOM" & ".xlsx"

If Len(Dir(strFolder_PathNew)) = 0 Then
'Copies the blank model "SOM.xlsx" to the 'L_Name' folder & renames it 'L_Name SOM.xlsx'.
FileCopy strSourceFolder & "" & "SOM.xlsx", strFolder_PathNew
Response = MsgBox(Me.[L_Name] & " SOM", vbOKOnly)

Set appExcel = CreateObject("Excel.Application")
With appExcel
.Visible = True
.UserControl = True

'Open the renamed 'SOM.xlsx' file in the associated folder & enter the 'Me.[data] into it.
With .Workbooks.Open(strFolder_PathNew)
lngLastDataRow = .Worksheets("Sheet1").Cells.SpecialCells(xlCellTyp eLastCell).Row
.Worksheets("Sheet1").range("D2") = Me.[Cust_No]
.Worksheets("Sheet1").range("D4") = Me.[F_Name] & " " & Me.[L_Name]
.Worksheets("Sheet1").range("D5") = Me.[Address]
.Worksheets("Sheet1").range("D6") = Me.[City] & ", " & Me.[State] & " " & Me![ZipCode]
.Worksheets("Sheet1").range("D8") = Me.[Phone_No]
.Worksheets("Sheet1").range("D9") = Me.[Cell_No]
.Worksheets("Sheet1").range("D10") = Me.[Work_No]
.Worksheets("Sheet1").range("D11") = Me.[Email]
End With
End With

appExcel.WindowState = xlMaximized

Else
MsgBox "The file has already exists. Use 'Edit SOM' to make changes.", vbOKOnly
End If
End If

'THE ABOVE CODE WORK GREAT, THANKS TO THIS FORUM!!!

'Gets the value in cell 'M59' from the closed 'L_Name Roof.xlsx (bidder) file & assigns it to 'MatlCost'
strFolder_PathNew = strFolder_Path & "\" & Me.[L_Name] & " Roof" & ".xlsx"
[B][COLOR=red]Set appExcelRoof = CreateObject("Excel.Application")
[/COLOR][/B]Set WkBk = [B][COLOR=Red]appExcelRoof.[/COLOR][/B]Workbooks.Open(strFolder_PathNew)
MatlCost = WkBk.Sheets(1).range("M59").Value

'AND, THE ABOVE CODE DOES, AS WELL.

'Closes the 'L_Name Roof.xlsx' BUT LEAVES AN EXCEL BLUE SCREEN DISPLAYIG
WkBk.Close True
[B][COLOR=red]appExcelRoof.Quit
Set appExcelRoof = Nothing
[/COLOR][/B]
[B][COLOR=red]appExcel.Worksheets("Sheet1").range("E14") = MatlCost
[/COLOR][/B]
'WHEN SUB IS RE-RUN AFTER DELETING THE 'l_Name SOM.xlsx'
'THAT WAS SAVE.
'Closes & saves the 'L_Name SOM.xlsx'

End Sub

 

[Punice]

Hello JHB,
The revisions & additions that you provided performed the 'magic' that I've been trying to achieve, daily, for the past 14 weeks. You can read my excuse(s) in my response to Gasman.
Thank for doing that and teaching me a bit more of the VBA code writing fundamentals.
I appreciate your prompt response, as well.

 

[JHB]

Hi, now the code runs it is time to clean and optimized the code.