Ja aan die link heb ik wel wat:
http://www.quandan.nl/tip.php?qdDocumentID=0000000047
Allen is mijn vraag:
Ik he de mappen / bestanden als nam in cellen staan, ik wil duin het visual basic stript linken naar di cellen maar dat lukt me niet.
kan iemand mij dit uitleggen?
b.v.d.
Dit is tot nu toe het visual basic script:
Sub qdListFiles()
Dim sPath As String
Dim sFile As String
Dim i As Integer
sPath = ActiveCell.Worksheet.Range("A1").Value
sFile = ActiveCell.Worksheet.Range("B1").Value
With Application.FileSearch
.NewSearch
.LookIn = sPath
.SearchSubFolders = False
.Filename = sFile
.MatchTextExactly = False
.FileType = msoFileTypeAllFiles
End With
ActiveCell.Worksheet.Range(Cells(2, 1), Cells(65536, 3)).ClearContents
ActiveCell.Worksheet.Range(Cells(2, 1), Cells(65536, 3)).ClearFormats
With Application.FileSearch
If .Execute() > 0 Then
ActiveCell.Worksheet.Cells(2, 1).Value = .FoundFiles.Count & " files found."
For i = 1 To .FoundFiles.Count
ActiveCell.Worksheet.Cells(i + 3, 1).Value = qdGetRightPartRightToLeft(.FoundFiles(i), "\")
ActiveCell.Worksheet.Cells(i + 3, 2).Value = qdGetLeftPartRightToLeft(.FoundFiles(i), "\") & "\"
ActiveCell.Worksheet.Hyperlinks.Add Anchor:=ActiveCell.Worksheet.Cells(i + 3, 6), Address:=.FoundFiles(i), TextToDisplay:="[Open dit bestand]"
Next i
Else
ActiveCell.Worksheet.Cells(2, 1).Value = "No files found."
End If
End With
End Sub
Function qdGetLeftPartRightToLeft(sSearch As String, sFind As String) As String
Dim iThisPos As Integer
Dim sResult As String
iThisPos = 1
Do While Not InStr(Right(sSearch, Len(sSearch) - iThisPos + 1), sFind) = 0
iThisPos = iThisPos + InStr(Right(sSearch, Len(sSearch) - iThisPos + 1), sFind) + Len(sFind) - 1
Loop
If iThisPos = 1 Then
Exit Function
Else
sResult = Left(sSearch, iThisPos - Len(sFind) - 1)
qdGetLeftPartRightToLeft = sResult
End If
End Function
Function qdGetRightPartRightToLeft(sSearch As String, sFind As String) As String
Dim iThisPos As Integer
Dim sResult As String
iThisPos = 1
Do While Not InStr(Right(sSearch, Len(sSearch) - iThisPos + 1), sFind) = 0
iThisPos = iThisPos + InStr(Right(sSearch, Len(sSearch) - iThisPos + 1), sFind) + Len(sFind) - 1
Loop
If iThisPos = 1 Then
Exit Function
Else
sResult = Right(sSearch, Len(sSearch) - iThisPos + 1)
qdGetRightPartRightToLeft = sResult
End If
End Function
Private Function GetValue(sPath, sFile, Sheet1, C1)
' Retrieves a value from a closed workbook
Dim sFile As String
Dim i As Integer
sPath = ActiveCell.Worksheet.Range("A1").Value
sFile = ActiveCell.Worksheet.Range("B1").Value
Dim arg As String
' Make sure the file exists
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
If Dir(sPath & sFile) = "" Then
GetValue = "File Not Found"
Exit Function
End If
' Create the argument
arg = "'" & sPath & "[" & sFile & "]" & Sheet1 & "'!" & _
Range(C1).Range(i + 3, 3).Address(, , xlR1C1)
' Execute an XLM macro
GetValue = ExecuteExcel4Macro(arg)
End Function
Het werkt nog niet, wie kan er eens naar kijken?
De bedoeling is dus, wat al wel werkt, dat je in Cel A1 de map invoerd, dat er vervolgens een lijst met de bestanden en de hyperlinks komt. Dit doet het us allemaal. maar nu wil ik specifieke informatie uit de cellen van die files.
Wie kan me helpen?
b.v.d.
