VBA訪問 - >自動導入Excel電子表格與HYPERLINKS

在這裏尋找一點幫助。我有一個相當簡單的Excel數據表，需要輸入到Access數據庫才能被操縱。但是，數據電子表格包含超鏈接。當我嘗試使用我的代碼時，它會爲超鏈接字段提供導入錯誤，並只導入空白字段。VBA訪問 - >自動導入Excel電子表格與HYPERLINKS

我完全無能爲力 - 任何人都可以幫助我解決這個問題嗎？我想用我的進口擅長的典型方法導入Access（我的代碼進口多擅長於一次基於陣列） - 這是如下：

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

請注意：我想進口的超鏈接是不只是網址，但也是網址的文字。我希望我可以導入超鏈接文本，但可悲的是，這不是一個選項。

來源

2013-07-08 user2296381

您應該實現一個導入過程。首先創建一個帶有超鏈接字段的表格，然後將數據從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-09 02:37:59 Nexus

太棒了！謝謝你的銀盤上的一切。我唯一的問題是導入任何字段爲dbNumeric或dbDate或dbCurrency，它總是吐出一個錯誤= /現在我符合導入全部爲dbText。知道我是否做錯了什麼？ – user2296381

對於dbNumberic和dbCurrency，該值必須始終包含數值（從0-9），即使「1,234」由於逗號而仍被視爲無效。所以你必須在複製之前先驗證你的數據。嘗試如果IsNumeric（xlSheet.Cells（m，5）.Value）然後 rec（「currency」）= xlSheet.Cells（m，5） – Nexus

如果你有到Excel文件直接訪問您可以添加一個新列追加的超級鏈接內容的哈希標誌兩側：

="#"&A1&"#"

複製這個公式向下列，複製和粘貼值刪除公式。然後重新導入到Access。

如果您沒有直接訪問這些文件，那麼您可以將它們導入臨時（空）表中，將超鏈接列插入到文本字段中。然後，您可以運行追加查詢，該查詢也修改此列，以便將其添加到超鏈接字段。

如果在導入到臨時表時該列遇到空白，那麼恐怕需要Excel自動化來打開文件並插入散列符號。

來源

2013-07-08 19:09:33

這將是一個工程/工具雛人們對自動化Excel的任務 - 遺憾的是具有雛人編輯事前是不是一個真正的選擇。至於你的其他選擇 - 你能給我一個代碼示例嗎？我不確定如何準確地做到這一點？我嘗試導入到超鏈接設置爲新字段類型的新表，但無濟於事。 – user2296381

我不知道如何使用導入超鏈接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-08 19:13:49 ashareef

VBA訪問 - >自動導入Excel電子表格與HYPERLINKS

回答

相關問題