0

これに関して、ここで少し助けを求めています。操作するために Access データベースに入力する必要があるかなり単純な Excel データシートがあります。ただし、データ スプレッドシートにはハイパーリンクが含まれています。コードを使用しようとすると、ハイパーリンク フィールドのインポート エラーが発生し、空のフィールドしかインポートされません。

私は全く無知です - 誰かがこれについて私を助けることができますか? 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

メモ フィールドを作成し、その属性を hyperlink に設定すると、魔法が起こります。

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 に答える