VBA Access -> 使用超链接自动导入 Excel 电子表格

VBA Access -> Automated Import an Excel Spreadsheet w/ HYPERLINKS

提问by user2296381

Looking for a wee bit of help here in regards to this. I have a fairly simple Excel datasheet that needs to be input into an Access database in order to be manipulated. However, the data spreadsheet includes a hyperlink. When I try to use my code it gives import errors for the hyperlink field and imports nothing but a blank field.

在这方面寻求一点帮助。我有一个相当简单的 Excel 数据表，需要输入到 Access 数据库中才能进行操作。但是，数据电子表格包含一个超链接。当我尝试使用我的代码时，它会为超链接字段提供导入错误，并且只导入一个空白字段。

I am absolutely clueless - can anyone help me on this one? I am trying to use my typical method of importing Excels into Access (my code imports multiple excels at once based on array) - which is below:

我完全一无所知-有人可以帮我解决这个问题吗？我正在尝试使用我将 Excel 导入 Access 的典型方法（我的代码基于数组一次导入多个 excel） - 如下：

DoCmd.TransferSpreadsheet acImport, , ls_tblImport, varFileArray(intCurrentFileNumber, 0) & varFileArray(intCurrentFileNumber, 1), True, "A1:BM" & ls_last_row

Please Note: The hyperlinks I am trying to import are not just URLs, but also Text for the URL.I wish I could just import the Hyperlink text, but sadly that isn't an option.

请注意：我尝试导入的超链接不仅是 URL，而且是 URL 的文本。我希望我可以只导入超链接文本，但遗憾的是这不是一个选项。

回答by Nexus

You should implement an import procedure. First create a table with hyperlink field then import your data from Excel into that table.

您应该执行导入程序。首先创建一个带有超链接字段的表格，然后将您的数据从 Excel 导入到该表格中。

Option Compare Database

Private Sub Command0_Click()
Dim rec As Recordset
Dim db As Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim xlApp As Object 'Excel.Application
Dim xlWrk As Object 'Excel.Workbook
Dim xlSheet As Object 'Excel.Worksheet


Set xlApp = CreateObject("Excel.Application")
Set xlWrk = xlApp.Workbooks.Open("C:\Users\....\Desktop\EMS Ver3.xlsm") 'Your directory
Set xlSheet = xlWrk.Sheets("SUMMARY") 'your sheet name
Set db = CurrentDb
Set tdf = db.CreateTableDef()
tdf.Name = "My table imported"

'Delete the table if it exists
If TableExists("My table imported") Then
    DoCmd.DeleteObject acTable, "My table imported"
End If

'Create table
Set fld = tdf.CreateField("hyperlinking", dbMemo, 150)
fld.Attributes = dbHyperlinkField + dbVariableField
tdf.Fields.Append fld
' append more field here if you want ...

With db.TableDefs
    .Append tdf
    .Refresh
End With

Set rec = db.OpenRecordset("My table imported")

m = 11 ' Let say your data is staring from cell E11 we will loop over column E until no data is read
Do While xlSheet.Cells(m, 5) <> ""
    rec.AddNew
    rec("hyperlinking") = xlSheet.Cells(m, 5)
    rec.Update
    m = m + 1
Loop
End Sub



Public Function TableExists(TableName As String) As Boolean
Dim strTableNameCheck
On Error GoTo ErrorCode

'try to assign tablename value
strTableNameCheck = CurrentDb.TableDefs(TableName)

'If no error and we get to this line, true
TableExists = True

ExitCode:
    On Error Resume Next
    Exit Function

ErrorCode:
    Select Case Err.Number
        Case 3265  'Item not found in this collection
            TableExists = False
            Resume ExitCode
        Case Else
            MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "hlfUtils.TableExists"
            'Debug.Print "Error " & Err.number & ": " & Err.Description & "hlfUtils.TableExists"
            Resume ExitCode
    End Select

End Function

The magic is when you create a Memo field and set its attribute to be hyperlink :

神奇的是，当您创建一个 Memo 字段并将其属性设置为超链接时：

Set fld = tdf.CreateField("hyperlinking", dbMemo, 150)
fld.Attributes = dbHyperlinkField + dbVariableField
tdf.Fields.Append fld

You can copy anything from Excel to that field while preserving the hyperlink:

您可以将任何内容从 Excel 复制到该字段，同时保留超链接：

rec("hyperlinking") = xlSheet.Cells(m, 5)

This is just an example. You need to modify your table name , your file directory , your spreadsheet name , your fields name, add more field if you want.

这只是一个例子。您需要修改表名、文件目录、电子表格名称、字段名称，如果需要，可以添加更多字段。

回答by Andy G

If you have direct access to the Excel files you could add a new column to append hash-signs either side of the hyperlink content:

如果您可以直接访问 Excel 文件，则可以添加一个新列以在超链接内容的任一侧附加哈希符号：

="#"&A1&"#"

Copy this formula down the column, copy and paste-values to remove the formulas. Then re-import to Access.

将此公式复制到列中，复制并粘贴值以删除公式。然后重新导入到 Access。

If you don't have direct access to the files then you could import them into a temporary (empty) table, inserting the hyperlink column into a text-field. Then you could run an Append Query that also modifies this column so that it is suitable to be appended to the hyperlink field.

如果您无法直接访问文件，则可以将它们导入临时（空）表，将超链接列插入文本字段。然后您可以运行一个附加查询，该查询也修改此列，使其适合附加到超链接字段。

If, when importing to the temporary table, the column comes across empty then I'm afraid it would require Excel Automation to open the file(s) and insert the hash-signs.

如果在导入到临时表时，该列是空的，那么恐怕需要 Excel 自动化来打开文件并插入哈希符号。

回答by ashareef

I don't know how to import hyperlinks using the DoCmd.TransferSpreadsheetas the import function only seems to grab the text for the URL even if the field is a hyperlink instead of text in Access. What I'm going to describe works (tested it) but doesn't seem to be the most direct route.

我不知道如何使用 导入超链接，DoCmd.TransferSpreadsheet因为导入功能似乎只会抓取 URL 的文本，即使该字段是超链接而不是 Access 中的文本。我将要描述的工作（已测试）但似乎不是最直接的路线。

Write a function in excel (or access and then open the file from access using an excel object) to add another column in your data where the text describing the link and the URL are in the form of text#url#.

在 excel 中编写一个函数（或访问，然后使用 excel 对象从 access 中打开文件）以在数据中添加另一列，其中描述链接和 URL 的文本采用text#url#.

From http://www.ozgrid.com/VBA/HyperlinkAddress.htm

来自http://www.ozgrid.com/VBA/HyperlinkAddress.htm

Function GetAddress(HyperlinkCell As Range)
    GetAddress = Replace(HyperlinkCell.Hyperlinks(1).Address, "mailto:", "")
End Function

e.g. Google#http://www.google.com/#

例如 Google#http://www.google.com/#

Now when you import it will import as a text but then once you change your field type to hyperlink it'll maintain the text and the link to the URL

现在，当您导入时，它将作为文本导入，但是一旦您将字段类型更改为超链接，它将保留文本和指向 URL 的链接