Export recordset to Excel Hyperlinks creating a second workbook

Question

Hello,

First time trying this.

Exporting a DAO.recordset into a formatted Excel file. Everything works except when I try to format the hyperlinks in a specific column. What happens is that the workbook is created, but when the hyperlinks are added, a second hidden workbook is created. The first workbook has all the data but no hyperlinks, but the second workbook (i.e. Book1) has all the data plus the hyperlinks. The hyperlinks are all in Column 36.

Here is some of the code:

    Set objExcelApp = CreateObject("Excel.Application")
    objExcelApp.Visible = False
    Set objExcelWkb = objExcelApp.Workbooks.Add
    Set objExcelSheet = objExcelApp.Worksheets(1)

    With objExcelSheet
        .Name = "Data Request"
        .Cells.Font.Name = "Calibri"
        .Cells.Font.Size = 12

'column headings

        For cols = 0 To rs.Fields.Count - 1
                .Cells(1, cols + 1).Value = rs.Fields(cols).Name
        Next       

'set price column in currency format
        .Columns("AD").NumberFormat = "$#,##0.00;-$#,##0.00"

'fill in the data starting at A2
        .Range("A2").CopyFromRecordset rs

        

'format hyperlinks

        For lngRow = 2 To ActiveCell.SpecialCells(xlLastCell).Row
            Set ranCell = Cells(lngRow, 36)
            If Left(ranCell, 8) = "https://" Then
                Call ActiveSheet.Hyperlinks.Add(Anchor:=ranCell, Address:=ranCell, TextToDisplay:=ranCell.text)
            End If
        Next lngRow

    End With

    rs.Close
    objExcelWkb.SaveAs (strPath)

Thank you for any help.

Albert

Answer 1

When asking questions, it truly helps us if you provide your full procedure this way we see declarations, error handling, ... all these things can impact functionality.

---

Daniel Pineault, 2010-2019 Microsoft MVP
Professional Support: http://www.cardaconsultants.com
MS Access Tips and Code Samples: http://www.devhut.net

Answer 2

The following works fine for me

    Dim objExcelApp           As Object
    Dim objExcelWkb           As Object
    Dim objExcelSheet         As Object
    Dim rs                    As DAO.Recordset
    Dim cols                  As Integer
    Dim lngRow                As Long
    Dim ranCell               As Object
    Const xlLastCell = 11
    Const strPath = "C:\temp\testing01.xlsx"

    Set rs = CurrentDb.OpenRecordset("urls")

    Set objExcelApp = CreateObject("Excel.Application")
    objExcelApp.Visible = False
    Set objExcelWkb = objExcelApp.Workbooks.Add
    Set objExcelSheet = objExcelApp.Worksheets(1)

    With objExcelSheet
        .Name = "Data Request"
        .cells.Font.Name = "Calibri"
        .cells.Font.Size = 12

        'column headings
        For cols = 0 To rs.Fields.Count - 1
            .cells(1, cols + 1).Value = rs.Fields(cols).Name
        Next

        'set price column in currency format
        .Columns("AD").NumberFormat = "$#,##0.00;-$#,##0.00"

        'fill in the data starting at A2
        .Range("A2").CopyFromRecordset rs

        'format hyperlinks
        For lngRow = 2 To objExcelApp.ActiveCell.SpecialCells(xlLastCell).Row
            Set ranCell = objExcelSheet.cells(lngRow, 3)
            If Left(ranCell, 8) = "https://" Then
                Call objExcelApp.ActiveSheet.Hyperlinks.Add(Anchor:=ranCell, Address:=ranCell, TextToDisplay:=ranCell.text)
            End If
        Next lngRow

    End With
    rs.Close
    objExcelWkb.SaveAs (strPath) '(1) What about file conflicts? ***
    '(2) Don't forget the either close Excel or make it visible to the user,
    '   otherwise you will be leaving a hidden running instance. ***

    Set rs = Nothing
    Set ranCell = Nothing
    Set objExcelSheet = Nothing
    Set objExcelWkb = Nothing
    Set objExcelApp = Nothing

 

You could, to simplify your code, also replace

Call objExcelApp.ActiveSheet.Hyperlinks.Add(Anchor:=ranCell, Address:=ranCell, TextToDisplay:=ranCell.text)

with

Call .Hyperlinks.Add(Anchor:=ranCell, Address:=ranCell, TextToDisplay:=ranCell.text)

because you are already within an objExcelSheet with statement

---

Daniel Pineault, 2010-2019 Microsoft MVP
Professional Support: http://www.cardaconsultants.com
MS Access Tips and Code Samples: http://www.devhut.net

Answer 3

OK, thank you so much. This line seems to have made the difference:

Set ranCell = objExcelSheet.cells(lngRow, 36)

Sorry about not posting all the code as it has a number of message boxes about sending the workbook by email or viewing, etc. I also have all the closing statements later on in the procedure.

Take care,

Albert