Avatar billede mrkr Juniormester
16. oktober 2008 - 11:18 Der er 8 kommentarer og
1 løsning

oprette mapper hvis de ikke findes udfra celle navn

Jeg har lavet en lille makro der gemmer mit ark i pdf.
Den gemmer filen som fakturanr + kundenr

Nu kunne jeg rigtigt godt tænke mig at udvidde koden lidt, så den gemmer filen i en undermappe der er = Sheets("faktura").Range("faktura_kundenr")

I teroien er det et nr. fra 1-1000
Hvis mappen ikke findes skal den oprette den, igen ud fra det nr. der står i:
Sheets("faktura").Range("faktura_kundenr")




Sub pdf_gem_som_og_åbn_ja()
  On Error GoTo fejl
    Sheets("Faktura").Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:="g:\dokument\" & " Faktura nr. " & Sheets("faktura").Range("faktura_nr") _
        & " - " & Sheets("faktura").Range("faktura_kundenr") & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Exit Sub
fejl:
MsgBox ("Der findes allerede en fil med dette navn")
End Sub
16. oktober 2008 - 12:11 #1
Jeg har ingen tests lavet, så det må du lige selv kigge på, og noter også, at jeg ændret på dit fil name i denne demo :-)

Public Sub Demo()
    Dim sDrive As String
    Dim sPath As String
    Dim sFileName As String
    Dim sKundeNr As String
    Dim sFakturaNr As String
   
    ' Variabel værdier
    sKundeNr = Sheets("faktura").Range("faktura_kundenr").Value
    sFakturaNr = Sheets("faktura").Range("faktura_nr").Value
    sDrive = "G:\"
    sPath = sDrive & "\document\"
    ' Check om mappe eksisterer ellers opret en mappe
    If Not CBool(Len(Dir(sPath & sKundeNr & "\", vbDirectory))) Then
        ChDrive sDrive
        ChDir sPath
        MkDir sKundeNr
    End If
    sPath = sPath & sKundeNr & "\"
   
    sFileName = sPath & "FakturaNr_" & sFakturaNr & "_" & sKundeNr & ".pdf"
   
    ' Check om fil eksisterer - Gem/Advarsel
    If Not CBool(Len(Dir(sFileName))) Then
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFileName, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=True
    Else
        MsgBox ("Der findes allerede en fil med dette navn")
    End If
End Sub
Avatar billede mrkr Juniormester
16. oktober 2008 - 14:27 #2
Den virker lige efter hensigten.
Mange tak for hjælpen
16. oktober 2008 - 15:11 #3
:-)
Avatar billede mrkr Juniormester
17. oktober 2008 - 17:55 #4
Lige et lille tillægsspørgsmål.

Hvis filen findes i forvejen. Kan man så få den til at slette / overskrive den gamle fil istedet for at give mig meddelelsen om at filen allerede findes?
17. oktober 2008 - 20:31 #5
Mener at ExportAsFixedFormat automatisk overskriver... så test ved at inaktivere lidt kode...

    ' Check om fil eksisterer - Gem/Advarsel
    If Not CBool(Len(Dir(sFileName))) Then
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFileName, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=True
    Else
        MsgBox ("Der findes allerede en fil med dette navn")
    End If


så det kommer til at se sådan ud - så der kun køres en linie


    ' Check om fil eksisterer - Gem/Advarsel
    'If Not CBool(Len(Dir(sFileName))) Then
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFileName, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=True
    'Else
    '    MsgBox ("Der findes allerede en fil med dette navn")
    'End If
Avatar billede mrkr Juniormester
19. oktober 2008 - 10:52 #6
Det overskriver desværre ikke automatisk.

Hvis der findes en fejl stopper koden i den linje der gemmer filen.
Så jeg tror vi skal ud i at slette filen først.
Avatar billede kabbak Professor
19. oktober 2008 - 15:40 #7
sæt denne ind lige før du gemmer
  If CBool(Len(Dir(sFileName))) Then Kill (sFileName)
Avatar billede mrkr Juniormester
20. oktober 2008 - 18:15 #8
Det viker 100%
Ikke mindst nu hvor det oprindelige spørgsmål er besvaret. :-)
Avatar billede mrkr Juniormester
20. oktober 2008 - 18:15 #9
Jeg mente:

Tusind tak for hjælpen....
Ikke mindst nu hvor det oprindelige spørgsmål er besvaret. :-)
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
Kategori
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig

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