Avatar billede Falentin Seniormester
24. februar 2019 - 19:44 Der er 2 kommentarer og
1 løsning

Problemer med dynamisk sti i VBA

Nedenståede skript henter alle sti navn i en mappe og dets undermappe, der inderholder ordet noter, og som er i word, og indsætter i et excelark.

Det virker fint med en fast sti, men jeg vil gerne være stien mere dynamisk (dvs, at sti kan ændre sig efter valg i bestemte celler). I mit tilfælde bruger jeg M4 som referer til et bestemt navn. Fx Medier.

Jeg vil gerne ændre ""C:\Users\Falentin\Desktop\Test\Medier\*Noter.docm*"" til noget a la:

Path = ThisWorkbook.Path & "\" & ThisWorkbook.Sheets("Gantt").Range("M4").Text & "\*Noter.docm*"

Men jeg kan ikke få det til at virke, nogen foreslag?
Kode:

Worksheets("CSV").Range("A1:G1").Value = Array("Name", "Size", "Type", "Created", "Accessed", "Modified", "Path")

NextRow = 2



Path = ThisWorkbook.Path & "\" & ThisWorkbook.Sheets("Gantt").Range("M4").Text & "\*Noter.docm*"


With CreateObject("Scripting.FileSystemObject")
    For Each file In Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR ""C:\Users\Falentin\Desktop\Test\Medier\*Noter.docm*"" /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".")
        With .GetFile(CStr(file))
            Range("A" & NextRow).Value = .Name
            Range("B" & NextRow).Value = Format((.Size / 1024), "000") & " KB"
            Range("C" & NextRow).Value = .Type
            Range("D" & NextRow).Value = .DateCreated
            Range("E" & NextRow).Value = .DateLastAccessed
            Range("F" & NextRow).Value = .DateLastModified
            Range("G" & NextRow).Value = .Path
        End With
        NextRow = NextRow + 1
    Next
End With
Avatar billede claes57 Ekspert
24. februar 2019 - 19:59 #1
har du prøvet at vise Path i en mgsboks, så du kan tjekke sti og antal \ og er det ok, så tag linjen
"CMD /C DIR ""C:\Users\Falentin\Desktop\Test\Medier\*Noter.docm*"" /S /B /A:-D"
og byg den i fx kommando="..." så du kan indsætte den uden dobbelte ""
.Exec(kommando) er lettere at håndtere
24. februar 2019 - 21:30 #2
Der er jo mange veje til Rom, så jeg har lige skruet lidt sammen, som måske kan inspirere dig - go leg

Public Sub getFileProperties()
    Dim aFiles As Variant, i As Integer, lRow As Long, filePath As String
   
    'Indsæt selv overskrifter
    lRow = 2
    filePath = "C:\_Projects\" 'læse fra arket
    aFiles = listFiles(filePath)
   
    If Not IsEmpty(aFiles) Then
        For i = LBound(aFiles) To UBound(aFiles)
            If Not InStr(1, "noter.docm") = 0 Then 'indsæt kun filer der indeholder noter.domc
                insertFileInfo filePath & aFiles(i), ActiveSheet, lRow
                lRow = lRow + 1
            End If
        Next i
    End If
   
End Sub


Function listFiles(ByVal sPath As String) As Variant
    'læser alle filer i et bibliotek ind i et array
    Dim vaArray As Variant, i As Integer
    Dim oFile As Object, oFSO As Object, oFolder As Object, oFiles As Object

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(sPath)
    Set oFiles = oFolder.Files

    If oFiles.Count = 0 Then Exit Function

    ReDim vaArray(1 To oFiles.Count)
    i = 1
    For Each oFile In oFiles
        vaArray(i) = oFile.Name
        i = i + 1
    Next

    listFiles = vaArray
End Function


Public Function insertFileInfo(ByVal sFile As String, ByVal ws As Worksheet, ByVal lRow As Long)
    'Indsætter værdier
    Dim fso As Object, f As Object

    On Error Resume Next
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFile(sFile)

    'Juster selv antal værdier og rækkefølge (Cells er hurtigere end Range)
    ws.Cells(lRow, 1).Value = f.Name
    ws.Cells(lRow, 2).Value = f.Size
    ws.Cells(lRow, 3).Value = f.DateCreated
    ws.Cells(lRow, 4).Value = f.DateLastModified
    ws.Cells(lRow, 5).Value = f.DateLastAccessed
    ws.Cells(lRow, 6).Value = f.Type
    ws.Cells(lRow, 7).Value = f.Attributes
    ws.Cells(lRow, 8).Value = f.Path
End Function
Avatar billede Falentin Seniormester
25. februar 2019 - 10:11 #3
Tak for det store arbejde, men jeg tror at jeg bare må have forskellige makroer for hver. Jeg bruger alligevel dem for 6 måneder ad gangen :-)
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester