Hyperlink jpg files in Dir via VBA

C

CAMoore

I'm using Access and Excel 2007. I would VERY much appreciate it if someone
could help me. If an Excel guru could help me out with item (1), I would be
very grateful. If you know how to help me with (2) also, I would be grateful
too.

I have a simple Access database with only one table and one form. My code
runs some VBA to open and Excel spreadsheet to get filenames and create
hyperlinks to pull back into an Access table.

I have one Button on the Access 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 gives 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
 
C

CAMoore

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. However, now I need help
figuring out how to ReFresh my form.

But I also still need help to figure out (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).

Thank you for any help you can offer.

--
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. If an Excel guru could help me out with item (1), I would be
very grateful. If you know how to help me with (2) also, I would be grateful
too.

I have a simple Access database with only one table and one form. My code
runs some VBA to open and Excel spreadsheet to get filenames and create
hyperlinks to pull back into an Access table.

I have one Button on the Access 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 gives 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...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Button on Form to refresh hyperlink data in table - error 1004 & 3 1
how do i loop thru all the worksheets in 2 files one by one 0
how to update a record from combo-box in user form? 0
If -Then in VBA Code 4
Search Files and Report Results in Date Range 0
Open/Close other workbooks with VBA; 1st one works, 2nd one fails 10
Macro to insert a hyperlink to external file 2
Importing EXCEL Spreadsheets into ACCESS -- Macro or VBA? 0

Top