Problem with code (error code 9)

[Vince]

I found the code to add values to a sheet without opening the sheet but am
trying to modify it and can't seem to figure out what I am doing wrong. I
need to find the next empty cell in column "A" and add the new values at that
row. Any thoughts or improvements to the code is greatly appreciated.

Here is the code:

Sub AddToFile()
Dim DestWB As Workbook
Dim DBFile As String
Dim mytitle As String

mytitle = "Add Data To File"

DBFile = "C:\Projects\Lowry\Estimate sheet for Bogner.xls"
'Check if Read / Write File Already Open
If FileLocked(DBFile) Then
msg = MsgBox("Read / Write File Already Open.", 16, mytitle)

Else
Application.ScreenUpdating = False
Set DestWB = Workbooks.Open(DBFile, Password:="mypassword")

r = 1 ******PROBLEM OCCURS AT NEXT STATEMENT***********
Do Until Workbooks(DBFile).Worksheets("Sheet2").Cells(r, 1) = ""
r = r + 1
Loop

With Worksheets(2).Range("A2:A2") '<< change as required
.Formula = mytitle
.Copy
.PasteSpecial Paste:=xlPasteValues
DestWB.Close True
End With

End If
Application.ScreenUpdating = True
End Sub

 

[Mike H]

Vinve,

When you open your workbook you set it as an object but then don't use it
you continue to refer to DBFile. Try this with a couple of provisos

I change the patch to save have to create your complicated one
O have no ide what ' If FileLocked(DBFile) Then does you must have another
sub so I commented the lot out.

Sub AddToFile()
Dim DestWB As Workbook
Dim DBFile As String
Dim mytitle As String
mytitle = "Add Data To File"

DBFile = "C:\book2.xlsx"

'Check if Read / Write File Already Open
' If FileLocked(DBFile) Then
' msg = MsgBox("Read / Write File Already Open.", 16, mytitle)

'Else
Application.ScreenUpdating = False
Set DestWB = Workbooks.Open(DBFile, Password:="mypassword")

r = 1 '******PROBLEM OCCURS AT NEXT STATEMENT***********
Do Until DestWB.Sheets("Sheet2").Cells(r, 1) = ""
r = r + 1

Loop

With Worksheets(2).Range("A2:A2") '<< change as required
.Formula = mytitle
.Copy
.PasteSpecial Paste:=xlPasteValues

DestWB.Close True
End With

'End If
Application.ScreenUpdating = True
End Sub

Mike

 

[OssieMac]

Hi Vince,

Change the line with error to following using the object you have set.

Do Until DestWB.Worksheets("Sheet2").Cells(r, 1) = ""

 

[Vince]

Thank you Mike H and OssieMac. Both solutions worked and answered my
question. Thanks again.