Problemen met VSB formules

[Nickdude]

Ik heb dit script, het werkt dus niet.....
kan iemand het voor mij oplossen?
het s de bedoeling dat er in kolom C bepaald waarde uit de in de kolom A en B aangegevenbestanden komen.

Dit is het script tot nu toe:



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

 

[Hans123]

Wat werkt er dan niet, op welke regel krijg je een fout melding ?

 

[Nickdude]

Ik krijg geen foutmelding, maar in de cel C4 en C5 en verder horen waardes van cellen in de bestanden te komen waarnaar in die regele verwijst wordt.

 

[Hans123]

Hoewel ik niet weet hoe deze functie wordt aangeroepen, gaat het volgens mij fout bij het maken van het argument in de functie getvalue.

probeer het volgende eens:

arg = "'" & sPath & "[" & sFile & "]" & Sheet1 & "'!" & _
Cells(i + 3, 3).Address(, , xlR1C1)

 

[Nickdude]

Hmmz, het werkt niet