Hi All,
EDIT:
I've now got a functional piece of code that exports a subset of my Access table to an Excel spreadsheet. Within the exported spreadsheet, the code also finds the cells which contain a certain value and replaces this value with a hyperlink.
(I was previously having issues with the hyperlinking, see attachment for original code that didn't work due to the UsedRange).
The problem is that the code uses Activate when looking for the cells to be hyperlinked, which I've since been advised not to use. The code also doesn't set the range of the Workbook dynamically. Full code is below.
The question/s are therefore, how can I change the code to avoid using Activate or Select, and how can I set the range of cells to be searched, dynamically?
Cheers
EDIT:
I've now got a functional piece of code that exports a subset of my Access table to an Excel spreadsheet. Within the exported spreadsheet, the code also finds the cells which contain a certain value and replaces this value with a hyperlink.
(I was previously having issues with the hyperlinking, see attachment for original code that didn't work due to the UsedRange).
The problem is that the code uses Activate when looking for the cells to be hyperlinked, which I've since been advised not to use. The code also doesn't set the range of the Workbook dynamically. Full code is below.
The question/s are therefore, how can I change the code to avoid using Activate or Select, and how can I set the range of cells to be searched, dynamically?
Code:
Public Function export_spreadsheet()
On Error GoTo ErrorHandler
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("qry_chief_people_officer")
DoCmd.Hourglass (True)
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = False
.Workbooks.Open _
("template.xlsx")
.ActiveWorkbook.SaveAs ("template " & Format(Now(), "DD-MMM-YY") & ".xlsx")
.ActiveWorkbook.Close
End With
Set xlBook = xlApp.Workbooks.Open("template " & Format(Now(), "DD-MMM-YY") & ".xlsx")
Set xlSheet = xlApp.Worksheets(1)
With xlSheet
.Name = "CPO_Records" 'Rename the sheet
For cols = 0 To rs.Fields.Count - 1
.Cells(2, cols + 1).Value = rs.Fields(cols).Name
Next
.Range("A3").CopyFromRecordset rs 'Copy data from recordsset to sheet
End With
'Adding the hyperlinks to the Excel spreadsheet
Dim firstAddress As String, c As Range, r As Range
With xlSheet.Range("A1:AJ200") 'Improvement would be to make this dynamic, based on the exported spreadsheet
Set c = Cells.Find(What:="Click here for further information", LookIn:=xlValues, Lookat:=xlWhole, _
MatchCase:=False)
If Not c Is Nothing Then
Set r = c
firstAddress = c.Address
Do
Set r = Union(r, c)
xlSheet.Range(c.Address).Activate
Set c = Cells.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
.Activate
If Not r Is Nothing Then r.Select
End With
ActiveSheet.hyperlinks.Add Anchor:=r, Address:= _
"MY-LINK" _
, TextToDisplay:="Click here for further information"
With xlApp
.ActiveWorkbook.Save
End With
Set xlBook = Nothing
Set xlSheet = Nothing
MsgBox "File saved to your (U:) drive", vbInformation + vbOKOnly, "Export Success"
DoCmd.Hourglass False
xlApp.Visible = True
ErrorHandler:
MsgBox "Export unsuccessful." & vbCrLf & vbCrLf & "The following error has occurred: " & Err.Description
Exit Function
End Function
Cheers
Attachments
Last edited: