Open file in verschillende Directory

[Chikita]

Hallo mensen,

Ik zou graag een bepaald bestand willen openen in Excel met behulp van een macro. Aangezien de directory van het bestand nog eens kan verschillen kan dit problemen opleveren. Zou ik graag te weten komen hoe je dit kan oplossen.

Dit is wat ik nu heb:

Workbooks.Open Filename:= _
"D:\Gebruikers\blabla\Desktop\VPN\Profiel.xls"


Alvast bedankt:thumb:

 

[migthy84]

weet je wel in welke ander directory het bestand kan staan

 

[Chikita]

Nee, dat weet ik zo niet. Is er geen mogelijk net zoals bij html dat je zeg maar zoiets kan gebruiken: ../Bestand.xls ?

 

[MartijnC86]

Lukt het niet hier mee?

Dim myName As String, n As Long, y As Long

Do
   
    myBestand = Application.GetOpenFilename( _
          FileFilter:="Excel bestand (*.xls), *.xls")

Workbooks.Open _
    Filename:=myBestand

 

[Chikita]

Je kan met jou code, het bestand openen? Is er niet zoiets, dat je er voor kan zorgen dat er gekeken word naar bijvoorbeeld 'Bestand.xls' in de map waar de geopende werkmap ook in staat? Dat zou voor mij de makkelijkste oplossing zijn.

 

[migthy84]

try cath block gebruiken

 

[Chikita]

Zo'n expert ben ik ook weer niet, ben net begonnen met dit allemaal

 

[migthy84]

Zo'n expert ben ik ook weer niet, ben net begonnen met dit allemaal

hebt je een error gemaakt met mappen
zoja is deze code voldoende

On Error Resume Next

array code

Dim strDirs(0 to 2) As String 
      
strDirs(0) = "D:\Gebruikers\blabla\Desktop\VPN\"
strDirs(1) = D:\Gebruikers\blabla\Desktop\VPN1\Profiel.xls"
strDirs(2) = D:\Gebruikers\blabla\Desktop\VPN2\Profiel.xls"

Sub my_for_loop1()
For a_counter = 0 to  4
  
Workbooks.open(strdirs(a_counter).toString(0 &  ""profiel.xls")
On Error Resume Next

Next a_counter

msgbox "The value of the counter in the last loop was " & a_counter
End Sub

 

[Warme bakkertje]

Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "Profiel.xls"

 

[Chikita]

Iedereen hartelijk bedankt die hier heeft gereageerd. Warme Bakker kwam met de oplossing van mijn probleem

Groeten Laurens

 

[Mark xl]

EDIT: ah. 1 minuut te laat dus

Probeer dit eens:
Plaats deze code in een nieuwe module, en roep vervolgens de procedure Go_Find als volgt op :

Go_Find "Profiel.xls", "D:\"
of
Call Go_Find("Profiel.xls", "D:\")

Succes.

Option Explicit
Private Errcnt As Integer
Sub Go_Find(filename As String, startfolder As String)
'Door Mark xl
'Zoek bestand   "filename"
'in map         "Startfolder"
Dim strpath As String

strpath = FindFilePath("D:\", filename, True)     'de functie FindfilePath geeft de locatie
                                                    'van het bestand terug
If strpath = "" Then
    MsgBox "Het bestand " & filename & " is niet gevonden.. (" & Errcnt & " error(s))"
Else
    Workbooks.Open strpath
End If
End Sub
Function FindFilePath(startfolder As String, filename As String, rootdir As Boolean) As String
'doorzoek alle mappen en submappen van map "Startfolder" totdat bestand "filename" gevonden is
Dim fs, fld, sfld, fldr, file
Dim strpath As String
Set fs = CreateObject("Scripting.FileSystemObject")
Set fld = fs.getfolder(startfolder)
'zoek bestanden uit de root

If rootdir Then
    'bestanden in de root directory
    For Each file In fld.Files
    
        If file.Name = filename Then
        
            FindFilePath = file.Path
            GoTo Foldererror:
        
        End If
    
    Next

End If

'submappen doorzoeken
For Each fldr In fld.SubFolders
    
    Set sfld = fs.getfolder(fldr)
    
    On Error GoTo Foldererror:
    
    'eerst bestanden in submap doorzoeken
    For Each file In sfld.Files
        
        If file.Name = filename Then
        
            FindFilePath = file.Path
            GoTo Foldererror:
        
        End If
    
    Next
    
    On Error GoTo 0
    
    'daarna submappen doorzoeken
    strpath = FindFilePath(sfld.Path, filename, False)
    
    'gevonden bestand doorgeven aan alle niveaus
    If strpath <> "" Then
    
        FindFilePath = strpath
        GoTo Foldererror:
    
    End If
    
Nextfldr:
Next

Foldererror:
    
    Select Case Err.Number
        Case 0      'geen error,  afsluiten
        
        Case 70     'map is beveiligd
            Resume Nextfldr:
        
        Case Else:
            Errcnt = Errcnt + 1
    End Select
    
Set fs = Nothing
Set fld = Nothing
Set sfld = Nothing
    
End Function