Directory opzoeken d.m.v. projectnummer

[CRUZ2]

Beste excel experts,

Ik wil doormiddel van een knop+macro een excel sheet opslaan in een bepaalde directory.

De knop met opslaan als lukt wel alleen de directory is een uitdaging

De directory die hij moet opzoeken bestaat uit de volgende items:

Als projectnummer met R begint dan zoeken in directory Projecten/R
Als projectnummer met t begint dan zoeken in directory Projecten/t

De map heeft nog een beschrijving achter het projectnummer bijv.:
R101010 is projectnummer
R101010 pietjes fiets is de directory

De knop moet dus zoeken naar de juiste directory en dan naar de eerste 7 karakters (projectnummer) voor de map.

Kan dit en zoja hoe?

Thanx in advance

Cruz

 

[Wigi]

Dag Julio

Sub wigi()
    For Each sf In CreateObject("Scripting.FileSystemObject").GetFolder("C:\Projecten\" & Left([A1], 1)).SubFolders
        If sf.Name Like "*" & [A1] & "*" Then
            ThisWorkbook.SaveAs "C:\Projecten\" & Left([A1], 1) & "\" & sf.Name & "\" & ThisWorkbook.Name
            Exit Sub
        End If
    Next
End Sub

Wigi

 

[Wigi]

Nog simpeler:

Sub wigi_2()
    sMap = "C:\Projecten\" & Left([A1], 1) & "\"
    ThisWorkbook.SaveAs sMap & Dir(sMap & [A1] & "*", 16) & "\" & ThisWorkbook.Name
End Sub

en aangezien oneliners op dit forum in de aanbieding zijn:

Sub wigi_2()
   ThisWorkbook.SaveAs "C:\Projecten\" & Left([A1], 1) & "\" & Dir("C:\Projecten\" & Left([A1], 1) & "\" & [A1] & "*", 16) & "\" & ThisWorkbook.Name
End Sub

 

[CRUZ2]

Hellup

Toppie voor de suggesties

Alleen heb ik geprobeerd allebie de oplossing toe te voegen maar hmmmm lukt me niet

Hieronder de Directory paden en het stukje hoe hij het bestand op moet slaan.

Teach me please hoe ik ze moet samenvoegen.

Paden die opgezocht moeten worden:

Als G8 met T begint:
T:\01 Projecten\01 Top\

Als G8 met R begint:
T:\01 Projecten\01 Rol\

Hierna juiste directory is R123456* of T123456* (* is toevoeging die alls wildcard opgezocht moet worden)

Subdirectory waar het bestand in opgeslagen moet worden is \sales\questionnaire\

Dus een hele pad van de r projecten is bijv.
T:\01 Projecten\01 Rol\R123456 hijsen\\sales\questionnaire\

De bestand naam wordt bepaald door deze macro/vb

Sub Opslaan_Dir()
Sheets("MCS").Copy
With ActiveWorkbook
With .Sheets(1).UsedRange
.Value = .Value
End With
.SaveAs "T:\Projecten\Rolloos\" & [G8].Value & " " & [A7].Value & ".xls"
.Close
End With
End Sub

Can you help me please:thumb::thumb:

 

[Wigi]

Ongetest, maar zou in orde moeten zijn:

Sub wigi_3()
    sMap = "T:\01 Projecten\01 " & IIf(Left([G8], 1) = "T", "Top", "Rol") & "\"
    ThisWorkbook.SaveAs sMap & Dir(sMap & [G8] & "*", 16) & "\sales\questionnaire\" & [G8] & " " & [A7] & ".xls"
End Sub

Graag ook code tags gebruiken op het forum aub. Dan komt code zoals hier in een apart venstertje te staan.

Wigi

 

[CRUZ2]

Fantastisch!!!!:thumb::thumb:

Werkt helemaal