Trever B said:
Hi All,
Thanks in advance.
Within code of my access form I need to open an excel file, find the first
worksheet and replace column and row indicated with its new contents.
Given the following (Linking is not an option) information can someone
help
me with the code.
Dim strFolder As String
Dim strFile As String
Dim strColRow As String
Dim StrColRowContents As String
strFolder = "C:\Working\"
strFile = "8504b.xls"
strColRow = "B4"
strColRowContents = "Shop Location"
Step 1
Open file How? (In this case Folder/File = "C:\Working\8504b.xls")
Step 2
Open first spreadsheet. How?
Step 3
find the row column ( in this case strColRow = "B4")
Step 4
Replace contents of B4 ( In this Case strColRowContents = "Shop
Location")
Step 5
Save File & exit File
Hope you can help.
Regards
Trev
Hi Trev,
I tried to find a link to this on Doug Steele's web site but couldn't, so
here it is in full, it should get you started.
Regards,
Keith.
www.keithwilby.com
Sub WriteToWorkbook(WorkbookName As String, WorksheetName As String)
' This code was originally written by
' Doug Steele, MVP (e-mail address removed)
'
' You are free to use it in any application
' provided the copyright notice is left unchanged.
'
' Description: This routine writes the words "Today's Date" into cell A1
' and today's date into cell B1.
' It accepts two arguments: the name of the workbook and the
' name of the worksheet in that workbook.
' It's expected that the workbook will exist in the same
' folder as the database. If it doesn't, this routine will
' create it. If the worksheet doesn't exist in the workbook,
' this routine will create it as well (at the end of the
workbook).
' Note that if the worksheet does exist, this routine will
' overwrite whatever was in cells A1 and B1.
'
' Inputs: WorkbookName String Name of the workbook
' (to exist in same folder as
database)
' WorksheetName String Name of the sheet in the workbook
On Error GoTo Err_WriteToWorkbook
Dim objActiveWkbk As Object
Dim objActiveWksh As Object
Dim objXL As Object
Dim booXLCreated As Boolean
Dim booWkbkCreated As Boolean
Dim intLastSheet As Integer
Dim strPath As String
Dim strWorkbookName As String
strPath = CurrentDb().Name
strPath = Left$(strPath, Len(strPath) - Len(Dir(strPath)))
strWorkbookName = strPath & WorkbookName
' Get a instance of Excel that we can use
' If it's already open, use it.
' Otherwise, create an instance of Excel
On Error Resume Next
Set objXL = GetObject(, "Excel.Application")
' An error will be raised if Excel isn't already open.
If Err.Number = 0 Then
booXLCreated = False
Else
Set objXL = CreateObject("Excel.Application")
booXLCreated = True
End If
On Error GoTo Err_WriteToWorkbook
' Check to see wheter the workbook exists
If Len(Dir(strWorkbookName)) > 0 Then
objXL.Application.Workbooks.Open strWorkbookName
booWkbkCreated = False
Else
objXL.Application.Workbooks.Add
booWkbkCreated = True
End If
Set objActiveWkbk = objXL.Application.ActiveWorkbook
' Determine whether WorksheetName exists in the workbook
On Error Resume Next
Set objActiveWksh = objActiveWkbk.Sheets(WorksheetName)
If Err.Number <> 0 Then
intLastSheet = objActiveWkbk.Worksheets.Count
objActiveWkbk.Worksheets.Add
After:=objActiveWkbk.Worksheets(intLastSheet)
Set objActiveWksh = objActiveWkbk.Sheets(intLastSheet + 1)
objActiveWksh.Name = WorksheetName
End If
On Error GoTo Err_WriteToWorkbook
objActiveWksh.Cells(1, 1) = "Today's Date"
objActiveWksh.Cells(1, 2) = Date
If booWkbkCreated = True Then
objActiveWkbk.SaveAs FileName:=strWorkbookName
Else
objActiveWkbk.Save
End If
End_WriteToWorkbook:
On Error Resume Next
objActiveWkbk.Close
Set objActiveWkbk = Nothing
If booXLCreated Then
objXL.Application.Quit
End If
Set objXL = Nothing
DoCmd.Hourglass False
Exit Sub
Err_WriteToWorkbook:
MsgBox Err.Number & ": " & Err.Description & " in WriteToWorkbook", _
vbOKOnly + vbCritical, "Smart Access Answer Column"
Resume End_WriteToWorkbook
End Sub
