VBA Access -> Automatisé Importer une feuille de calcul Excel w/ liens hypertexte

Vous devez mettre en œuvre une procédure d'importation. D'abord créer une table avec un champ lien hypertexte puis importer vos données à partir d'Excel dans cette table.

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

La magie, c'est quand vous créez un champ Mémo et de définir son attribut de lien hypertexte :

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

Vous pouvez copier quoi que ce soit à partir d'Excel dans ce domaine, tout en préservant le lien hypertexte:

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

C'est juste un exemple. Vous avez besoin de modifier le nom de votre table , votre répertoire de fichiers , votre nom de feuille de calcul , votre nom des champs, ajouter plus de terrain si vous le souhaitez.

Je ne sais pas comment faire pour importer des hyperliens à partir de l' DoCmd.TransferSpreadsheet que la fonction d'importation ne semble saisir le texte de l'URL, même si le champ est un lien hypertexte à la place du texte dans l'Accès. Ce que je vais décrire des œuvres (testé), mais ne semble pas être la voie la plus directe.

Écrire une fonction dans excel (ou access et ouvrez le fichier à partir de l'accès à l'aide d'un objet excel) pour ajouter une autre colonne dans vos données, où le texte décrivant le lien et l'URL sont sous la forme de text#url#.

De http://www.ozgrid.com/VBA/HyperlinkAddress.htm

Function GetAddress(HyperlinkCell As Range)
GetAddress = Replace(HyperlinkCell.Hyperlinks(1).Address, "mailto:", "")
End Function

par exemple Google#http://www.google.com/#

Maintenant, lorsque vous importer pour importer un texte, mais une fois que vous changez de type de champ lien hypertexte, il va maintenir le texte et le lien vers l'URL