您应该实施导入程序。首先创建一个带有超链接字段的表格,然后将您的数据从 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)
这只是一个例子。您需要修改表名、文件目录、电子表格名称、字段名称,如果需要,可以添加更多字段。