0

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

我完全一无所知 - 任何人都可以帮我解决这个问题吗?我正在尝试使用我将 Excel 导入 Access 的典型方法(我的代码基于数组一次导入多个 excel)-如下:

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

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

4

3 回答 3

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)

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

于 2013-07-09T02:37:59.180 回答
0

如果您可以直接访问 Excel 文件,则可以添加一个新列以在超链接内容的任一侧附加井号:

="#"&A1&"#"

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

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

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

于 2013-07-08T19:09:33.350 回答
0

我不知道如何使用DoCmd.TransferSpreadsheet导入功能导入超链接,即使该字段是超链接而不是 Access 中的文本,它似乎也只能获取 URL 的文本。我要描述的工作(经过测试)但似乎不是最直接的途径。

在 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

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

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

于 2013-07-08T19:13:49.497 回答