Makro og VBA - Opret folder efter cellenavn

Print side | Luk vindue

Opret folder efter cellenavn

Udskrevet fra: Dansk Regneark Forum
Kategori: Hjælp til regneark.
Forum navn: Makro og VBA
Forum beskrivelse: Hjælp til Makroer og VBA-programmering
Web-adresse: https://forum.excel-regneark.dk/forum_posts.asp?TID=3086
Udskrevet den: 06.Maj.2024 kl. 09:16

Emne: Opret folder efter cellenavn

Besked fra: kbno
Emne: Opret folder efter cellenavn
Posteringsdato: 03.Jul.2017 kl. 11:56

Hej Med Jer

Jeg har følgende kode som jeg bruger til at oprette en folder på skrivebordet. Men nu vil jeg godt have lavet en underfolder med navnet som findes i en celle i fanen "Oprettelse".

Jeg er klar over at det er i linien med "DataSti", men har desværre ikke fundet noget kode der virker.

Håber der er en som kan hjælpe Smile

Sub gemsom_PDF()

Dim ArkNavn, DataSti, Filnavn As String
Dim objFolders As Object
Set objFolders = CreateObject("WScript.Shell").SpecialFolders

ArkNavn = ActiveSheet.Name
DataSti = objFolders("Desktop") & "\Aftalesedler\"

Filnavn = Sheets(ArkNavn).[B4].Value & " " & Sheets(ArkNavn).[c4].Value & " - " & Sheets(ArkNavn).[H10].Value & " - " & Sheets(ArkNavn).[H4]

If Dir(DataSti, vbDirectory) = "" Then
    MkDir DataSti
End If

Sheets(ArkNavn).ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=DataSti & Filnavn, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    From:=1, To:=1, _
    OpenAfterPublish:=False
MsgBox "Filen er gemt som: " & Filnavn & ".pdf" & " på skrivebordet", vbInformation
End Sub

-------------
Hygge - Kim
Excel 365 DK user

Svar:

Besked fra: EXCELGAARD
Posteringsdato: 03.Jul.2017 kl. 12:30

Hej Kim,

MkDir funktionen har desværre en række begrænsninger - bl.a. kan funktionen ikke lave en komplet sti i 'et hug', men skal oprette, hvert eneste trin i stien for sig selv.

Må jeg anbefale, at du benytter 'MakeDIRs' API'en i stedet - den er langt mere robust, og 100% kompatibel med Windows /da det jo et Window' egen API, der benyttes).

www.excelgaard.dk/Bib/API/MakeDIRs/ www.excelgaard.dk/Bib/API/MakeDIRs/

-------------
Husk, at trykke på [Tak], hvis du kan lide et indlæg.
Husk, at trykke på [Accepteret Svar], hvis du kan bruge et løsningsforslag.

Besked fra: kbno
Posteringsdato: 03.Jul.2017 kl. 13:07

Hej Excelgaard

Hvis jeg læser koden så kræver den en konstant sti. Mit behov er at jeg skal oprette underfolderen ud fra en tekst i celle G5 fra fanen "oprettelse"

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: EXCELGAARD
Posteringsdato: 03.Jul.2017 kl. 14:42

Arj, kom nu, Kim Smile

Du kan vel finde ud af, at lave en konstant om til en variabel???

    Dim Path_To_Make As String
    Path_To_Make = Sheets("Oprettelse").Range("G5").Value
' Or...
    Path_To_Make = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Aftalesedler\" & Sheets("Oprettelse").Range("G5").Value

Eller er det mig, der helt misforstår opgaven???

-------------
Husk, at trykke på [Tak], hvis du kan lide et indlæg.
Husk, at trykke på [Accepteret Svar], hvis du kan bruge et løsningsforslag.

Besked fra: kbno
Posteringsdato: 04.Jul.2017 kl. 08:48

Hej Excelgaard

Jeg er en novice i VBA og roder yderst sjældent med det. Så jeg skal starte fra nul hver gang Cry

Jeg har sågar problemer med at få din kode lagt ind i mit script Ouch

Jeg tror såmænd ikke du har misforstået opgaven, det er nok bare mig der ikke magter løsningen Big smile

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: EXCELGAARD
Posteringsdato: 04.Jul.2017 kl. 09:20

Stadig prisværdigt, at du prøver Thumbs Up

Der, hvor da har 'DataSti=', vil jeg mene, at du skal have

DataSti = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Aftalesedler\" & Sheets("Oprettelse").Range("G5").Value

...og, så skal du naturligvis huske, at ligge API funktionen i toppen af modulet, som vist i min link til API funktionen.

Hvis du stadig ikke kan få det til, at virke, er du nok nødt til at /topic662.html - uploade dit regneark...

-------------
Husk, at trykke på [Tak], hvis du kan lide et indlæg.
Husk, at trykke på [Accepteret Svar], hvis du kan bruge et løsningsforslag.

Besked fra: kbno
Posteringsdato: 04.Jul.2017 kl. 09:30

Jeg har sendt dig en PM Star

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: EXCELGAARD
Posteringsdato: 04.Jul.2017 kl. 15:23

OK, prøv med denne:

Sub GemSom_PDF()

  Dim ArkNavn, DataSti, Filnavn As String

  ArkNavn = ActiveSheet.Name
  DataSti = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\Aftalesedler\" & Sheets("Oprettelse").Range("G5").Value & "\"
  Filnavn = Sheets(ArkNavn).[B4].Value & " " & Sheets(ArkNavn).[D4].Value & " - " & Sheets(ArkNavn).[H4]

' Tjekker om mappen 'DataSti' eksisterer, hvis ikke oprettes den
  MakeDIRs DataSti

' Indsætter versions nummer på udskrift
' ActiveSheet.PageSetup.RightFooter = Sheets("Forside").Range("G4").Value

' Gemmer det aktive ark som .PDF
  Sheets(ArkNavn).ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=DataSti & Filnavn, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    From:=1, To:=1, _
    OpenAfterPublish:=False

' Besked boks om filenavn '& DataSti'
  MsgBox "Filen er gemt som: " & Filnavn & ".pdf" & " på skrivebordet", vbInformation

End Sub

Den virker hos mig Smile

-------------
Husk, at trykke på [Tak], hvis du kan lide et indlæg.
Husk, at trykke på [Accepteret Svar], hvis du kan bruge et løsningsforslag.

Besked fra: kbno
Posteringsdato: 05.Jul.2017 kl. 12:22

Det er bare perfekt Big smile

-------------
Hygge - Kim
Excel 365 DK user

Besked fra: EXCELGAARD
Posteringsdato: 05.Jul.2017 kl. 13:23

Velbekomme - husk, at acceptere svaret Smile

-------------
Husk, at trykke på [Tak], hvis du kan lide et indlæg.
Husk, at trykke på [Accepteret Svar], hvis du kan bruge et løsningsforslag.

Print side | Luk vindue