Question

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

我绝对无能为力 - 有人可以帮助我吗？我正在尝试使用我将Excel导入Access的典型方法（我的代码基于数组一次导入多个excel） - 如下所示：

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

请注意：我尝试导入的超链接不仅仅是网址，还包含网址的文字。我希望我可以导入超链接文字，但遗憾的是这不是一个选项

Answer 1

您应该实施导入程序。首先创建一个包含超链接字段的表，然后将您的数据从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

当您创建备注字段并将其属性设置为超链接时，神奇之处在于：

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

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

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

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

Answer 2

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

="#"&A1&"#"

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

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

如果在导入到临时表时，该列遇到空，那么我担心它会要求Excel Automation打开文件并插入哈希符号。

Answer 3

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

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

来自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/#

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

VBA访问 - ＆gt;使用/ HYPERLINKS自动导入Excel电子表格

3 个答案: