Directory maken met naam uit cel van de actieve rij.

[HarryBee]

Beste helpers,

Weten jullie misschien de oplossing? Ik wil een map aanmaken in C:\temp\ met een naam uit een cel van kolom 9 uit de actieve rij als de cel uit kolom 9 en 15 van dezelfde actieve rij een waarde bevat.

Ik had zelf zoiets van:

Sub MakeDir()
Dim strDir As String
strDir= C:\Temp\ & Cells(Target.Row,9)
If Cells(Target.Row,15)<>   Then
If Dir(strDir, vbDirectory)=   Then
MkDir strDir
Else
MsgBox De map bestaat al
End If
End If
End Sub
[/CODE[/FONT]]

Fout 400

Alvast mijn dank.

Groet harry

 

[Niels28]

With CreateObject("Scripting.FileSystemObject")
    If Not .FolderExists(strdir & "\") Then .CreateFolder strdir & "\"
End With

Niels

 

[OctaFish]

Waar komt Target.Row vandaan? Je kunt niet naar een Target verwijzen als die niet bestaat. Dus die moet je in ieder geval of vervangen door een range, of goed vastleggen.

 

[HarryBee]

Niels,

Dit is in ieder geval iets waar ik wat aan heb. Dank je tot zo ver.
Nu alleen de voorwaarden nog. In de cel van kolom 9 komt na het invullen van een regel een samengevoegde naam te staan, die uiteindelijk als de cel in kolom 15 niet leeg is, als naam voor de map moet dienen.

Groet Harry

 

[HarryBee]

Octafish,

Je hebt gelijk. Het gaat om de actieve rij en doel cel. Ik had ook zoiets, dat het met een gedefineerde range wel zou moeten lukken, maar het bestand bestaat uit een soort kalender, waar de maanden onder elkaar staan. Elke maand heeft standaard 7 regels. Dan een lege regel. Dan weer de volgende maand. enzovoort. D.m.v. een stukje code kan ik regels tussenvoegen. Doordat ik Range( I:I ) (dubbele aanhalingstekens werken niet), gebruikte, zat ik in de knoei met de koptekst van de onderliggende maand.
Ik zal een klein voorbeeldbestandje plaatsen.

Groet Harry

 

[HarryBee]

Beste Helpers,

Ik heb mijn probleem opgelost met de volgende code:

Private Sub Worksheet_Change(ByVal Target As Range)
'Met deze code maak je een map en een DOC aan met link daar naartoe.
Application.ScreenUpdating = False
Worksheets("Blad4").Unprotect ("test")
 
On Error Resume Next
 
If Target.Column = 15 Then
 
nwDir = Cells(Target.Row, 9)
mN = "C:\Temp" & nwDir
 
Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
        If Not fs.folderexists("C:\Temp\" & nwDir) Then
            MkDir mN
            MsgBox "De map ( " & nwDir & " ) is aangemaakt. Druk op de snelkoppeling om uw documenten toe te voegen."
        Else
            MsgBox "De map ( " & nwDir & " ) bestaat al."
        End If
       
        Cells(Target.Row, 16) = "1"
        ActiveSheet.Hyperlinks.Add Anchor:=Cells(Target.Row, 16), Address:=mN
        Cells(Target.Row, 16).Font.Name = "Wingdings"
 
If Target.Column = 15 Then
 
    Dim Wrd As Object
        Application.ScreenUpdating = False
        Bestandsnaam = "C:\Temp\Docs\" & Cells(Target.Row, 9) & ".doc"
    Set Wrd = CreateObject("Word.Application")
    Wrd.Visible = False
        If Dir(Bestandsnaam) <> "" Then
            response = MsgBox("Het informatiebestand bestaat al. Wilt u dit overschrijven? LET OP! Kies Nee als u het niet zeker weet", vbYesNo + vbCritical + vbDefaultButton2)
            
            If response = vbYes Then
                Wrd.Documents.Add
                Wrd.ActiveDocument.SaveAs Bestandsnaam
                Wrd.Quit
                Set Wrd = Nothing
            End If
    Else
                Wrd.Documents.Add
                Wrd.ActiveDocument.SaveAs Bestandsnaam
                Wrd.Quit
                Set Wrd = Nothing
   
            End If
       
            Cells(Target.Row, 17) = "u"
            ActiveSheet.Hyperlinks.Add Anchor:=Cells(Target.Row, 17), Address:=Bestandsnaam
            Cells(Target.Row, 17).Font.Name = "Wingdings"
           
Worksheets("Blad4").Protect ("test")
Application.ScreenUpdating = True
        End If
End If
End Sub

Misschien heeft iemand er wat aan. In ieder geval mijn dank voor het meedenken.

Groet Harry