Button on Form to refresh hyperlink data in table - error 1004 & 3

  • Thread starter Thread starter CAMoore
  • Start date Start date
C

CAMoore

I'm using Access and Excel 2007. I would VERY much appreciate it if someone
could help me.

I have a simple Access database with only one table and one form. I have
one Button on the form (cmdRefresh) in the Form Header section and three
fields in the Form Detail section. The table field names for tblHyperlink
are: ID, Filename, and LinkURL.

All this database is doing is looking in a static directory and filling
column A in an Excel spreadsheet with jpg filenames. Then it creates
hyperlinks to the jpg files in column B. Then it imports the Excel
spreadsheet back into the Access table named tblHyperlinks.

(1) The problem is that it runs okay the first time I click the button and
the second time I click the button it gives me a Run-time error 1004 Method
Worksheet of Object _Global failed. (So I actually need help with this).
Plus...

(2) I didnt notice until I had 182,000 records in the tblHyperlink table
that it needs to "clean out" the tblHyperlinks table before it Imports, so I
put a line of code to delete the tblHyperlinks before it imports the Excel
spreadsheet, and it give me a Run-time error 3211 the database engine could
not lock table 'tblHyperlinks' because it is already in use by another person
or process.

The code behind the cmdRefresh button is this:

Private Sub cmdRefresh_Click()
Call ListFilenames
End Sub

The ListFilenames code in the basRefreshHyperlinks module is this:

Public Sub ListFilenames()
'====================================================
'Initialize variables
'====================================================
Dim xl As New Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim Directory As String
Dim Filename As String
Dim MySheet As Worksheet
Dim rw As Long
Dim LastRow As Long
Dim picCnt As Integer

' On Error GoTo TCOT
' DoCmd.SetWarnings False

'Show Excel. This is optional.
xl.Visible = True

'Open the workbook.
Set wb = xl.workbooks.Open("C:\temp\Hyperlinks.xls")

'Get a reference to the first worksheet.
Set ws = wb.Worksheets("Sheet1")

picCnt = 0

'====================================================
'Activate Filenames worksheet
'====================================================
Worksheets("Sheet1").Activate
Set MySheet = ActiveSheet
Set ws = ActiveSheet

'====================================================
'Delete columns A and B
'====================================================
MySheet.Columns("A:B").Delete Shift:=xlToLeft
'Columns("A:B").Delete Shift:=xlToLeft

'====================================================
'Add Column Headers
'====================================================
Range("A1").Select
ActiveCell.FormulaR1C1 = "Filename"
Range("B1").Select
ActiveCell.FormulaR1C1 = "LinkURL"

'====================================================
'Change the directory below as needed
'====================================================
Directory = "N:\Parts\"
If Left(Directory, 1) <> "\" Then
Directory = Directory & "\"
End If

Filename = Dir(Directory & "*.jpg")

'====================================================
'Populate column A with filenames
'====================================================
rw = 2
Do While Filename <> ""
MySheet.Cells(rw, 1).Value = Filename
'ws.Cells(rw, 1).Value = Filename
rw = rw + 1
Filename = Dir
'picCnt = picCnt + 1
Loop

'====================================================
'Find the row number of the last record
'====================================================
LastRow = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
'LastRow = ws.Range("A65536").End(xlUp).Row

'====================================================
'Create Hyperlinks
'====================================================
With Worksheets("Sheet1").Range("B2")
'With ws.Range("B2")
.FormulaR1C1 = "=HYPERLINK(""N:\Parts\""&RC[-1])"
.AutoFill Destination:=Range("B2:B" & LastRow)
End With

'====================================================
'Format worksheet
'====================================================
ws.Columns("A:B").EntireColumn.AutoFit
'MsgBox "Number of pics: " & picCnt, vbOKOnly

'====================================================
'Delete tblHyperlinks table and Import Hyperlinks Spreadsheet
'====================================================
'DoCmd.DeleteObject acTable, "tblHyperlinks"

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, _
"tblHyperlinks", "X:\Temp\Hyperlinks.xls", True, "Sheet1!"

'====================================================
'Wrap up
'====================================================
ws.Range("A1").Select

'Save
wb.Save

'Close the workbook.
wb.Close

'Quit Excel
xl.Quit

Set ws = Nothing
Set wb = Nothing
Set xl = Nothing
Set MySheet = Nothing

' DoCmd.SetWarnings True
'
'TCOT:
' Exit Sub

End Sub
 
Okay. I figured out what I need to do to "Clear Out" all the old records out
of the tblHyperlinks table. I needed to create a Sub procedure (or one could
create a Delete Query and call the query, I suppose).

So, now the code behind the cmdRefresh button is this:

Private Sub cmdRefresh_Click()
Call DeleteRecords <-------------------Added this to "clean out" table
Call ListFilenames
End Sub

and my DeleteRecords code in the module looks like this:

Public Sub DeleteRecords()
Dim strSQL As String
strSQL = "DELETE * FROM tblHyperlinks;"
DoCmd.RunSQL strSQL
End Sub

But...I need to know how to ReFresh my form after I delete all the records
in the table and import from Excel. It still shows all the fields as #####
until I close the form and open it back up again. Can you help me?


--
Other programming languages I''''ve used are: Cobol, C++, Informix Database,
and Unix.


CAMoore said:
I'm using Access and Excel 2007. I would VERY much appreciate it if someone
could help me.

I have a simple Access database with only one table and one form. I have
one Button on the form (cmdRefresh) in the Form Header section and three
fields in the Form Detail section. The table field names for tblHyperlink
are: ID, Filename, and LinkURL.

All this database is doing is looking in a static directory and filling
column A in an Excel spreadsheet with jpg filenames. Then it creates
hyperlinks to the jpg files in column B. Then it imports the Excel
spreadsheet back into the Access table named tblHyperlinks.

(1) The problem is that it runs okay the first time I click the button and
the second time I click the button it gives me a Run-time error 1004 Method
Worksheet of Object _Global failed. (So I actually need help with this).
Plus...

(2) I didnt notice until I had 182,000 records in the tblHyperlink table
that it needs to "clean out" the tblHyperlinks table before it Imports, so I
put a line of code to delete the tblHyperlinks before it imports the Excel
spreadsheet, and it give me a Run-time error 3211 the database engine could
not lock table 'tblHyperlinks' because it is already in use by another person
or process.

The code behind the cmdRefresh button is this:

Private Sub cmdRefresh_Click()
Call ListFilenames
End Sub

The ListFilenames code in the basRefreshHyperlinks module is this:

Public Sub ListFilenames()
'====================================================
'Initialize variables
'====================================================
Dim xl As New Excel.Application
Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim Directory As String
Dim Filename As String
Dim MySheet As Worksheet
Dim rw As Long
Dim LastRow As Long
Dim picCnt As Integer

' On Error GoTo TCOT
' DoCmd.SetWarnings False

'Show Excel. This is optional.
xl.Visible = True

'Open the workbook.
Set wb = xl.workbooks.Open("C:\temp\Hyperlinks.xls")

'Get a reference to the first worksheet.
Set ws = wb.Worksheets("Sheet1")

picCnt = 0

'====================================================
'Activate Filenames worksheet
'====================================================
Worksheets("Sheet1").Activate
Set MySheet = ActiveSheet
Set ws = ActiveSheet

'====================================================
'Delete columns A and B
'====================================================
MySheet.Columns("A:B").Delete Shift:=xlToLeft
'Columns("A:B").Delete Shift:=xlToLeft

'====================================================
'Add Column Headers
'====================================================
Range("A1").Select
ActiveCell.FormulaR1C1 = "Filename"
Range("B1").Select
ActiveCell.FormulaR1C1 = "LinkURL"

'====================================================
'Change the directory below as needed
'====================================================
Directory = "N:\Parts\"
If Left(Directory, 1) <> "\" Then
Directory = Directory & "\"
End If

Filename = Dir(Directory & "*.jpg")

'====================================================
'Populate column A with filenames
'====================================================
rw = 2
Do While Filename <> ""
MySheet.Cells(rw, 1).Value = Filename
'ws.Cells(rw, 1).Value = Filename
rw = rw + 1
Filename = Dir
'picCnt = picCnt + 1
Loop

'====================================================
'Find the row number of the last record
'====================================================
LastRow = Worksheets("Sheet1").Range("A65536").End(xlUp).Row
'LastRow = ws.Range("A65536").End(xlUp).Row

'====================================================
'Create Hyperlinks
'====================================================
With Worksheets("Sheet1").Range("B2")
'With ws.Range("B2")
.FormulaR1C1 = "=HYPERLINK(""N:\Parts\""&RC[-1])"
.AutoFill Destination:=Range("B2:B" & LastRow)
End With

'====================================================
'Format worksheet
'====================================================
ws.Columns("A:B").EntireColumn.AutoFit
'MsgBox "Number of pics: " & picCnt, vbOKOnly

'====================================================
'Delete tblHyperlinks table and Import Hyperlinks Spreadsheet
'====================================================
'DoCmd.DeleteObject acTable, "tblHyperlinks"

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, _
"tblHyperlinks", "X:\Temp\Hyperlinks.xls", True, "Sheet1!"

'====================================================
'Wrap up
'====================================================
ws.Range("A1").Select

'Save
wb.Save

'Close the workbook.
wb.Close

'Quit Excel
xl.Quit

Set ws = Nothing
Set wb = Nothing
Set xl = Nothing
Set MySheet = Nothing

' DoCmd.SetWarnings True
'
'TCOT:
' Exit Sub

End Sub
Click to expand...
 
Back
Top