Hi,
In excel heb ik een database met onder andere hyperlinks naar bestanden op de computer.
Nu wil ik in een ander workbook deze database importeren. Dit gaat goed alleen krijg ik de hyperlinks als platte tekst geïmporteerd.
Weet iemand wat ik aan de code moet veranderen zodat hij ook de hyperlinks meeneemt?
Ik heb ook al geprobeerd om de selectie te selecteren, kopieren en te plakken maar dit werkt ook niet.
Volgens mij gaat het bij regel 34 en 35 hieronder niet goed.
In excel heb ik een database met onder andere hyperlinks naar bestanden op de computer.
Nu wil ik in een ander workbook deze database importeren. Dit gaat goed alleen krijg ik de hyperlinks als platte tekst geïmporteerd.
Weet iemand wat ik aan de code moet veranderen zodat hij ook de hyperlinks meeneemt?
Ik heb ook al geprobeerd om de selectie te selecteren, kopieren en te plakken maar dit werkt ook niet.
Volgens mij gaat het bij regel 34 en 35 hieronder niet goed.
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
| Private Sub import_Click()
Dim Target_Workbook As Workbook
Dim Source_Workbook As Workbook
Dim Source_Path As String
Dim source As FileDialog
Dim selectedFile As String
Set source = Application.FileDialog(msoFileDialogFilePicker)
On Error Resume Next
With source
.Title = "Selecteer bestand met bonnen en contacten"
.AllowMultiSelect = False
.InitialFileName = ThisWorkbook.Path
.Show
selectedFile = .SelectedItems(1)
End With
'''''Assign the Workbook File Name along with its Path
'''''Change path of the Target File name
Source_Path = selectedFile
Set Source_Workbook = Workbooks.Open(Source_Path)
Set Target_Workbook = ThisWorkbook
'''''With Target_Workbook object now, it is possible to pull any data from it
'''''Read Data from Target File
Source_Data = Source_Workbook.Worksheets("Bonnen").Range("A2:G999")
Target_Workbook.Worksheets("Bonnen").Range("A2:G999") = Source_Data
'''''Close Target Workbook
Target_Workbook.Save
Source_Workbook.Close False
'''''Process Completed
MsgBox "Bonnen en contacten zijn geimporteerd"
End Sub |