Avatar billede joergensenmartin Juniormester
07. oktober 2019 - 10:15 Der er 8 kommentarer og
1 løsning

VBA opret mappe og gemsom i mappen

Hej

Er grøn i vba og har derfor et sikkert let spørgsmål. Jeg har den her kode:

Private Sub GemSom_Click()

'kode der danner mappen:
If Dir(ThisWorkbook.Path & "\" & Range("b6").Value & " " & Date, vbDirectory) = "" Then
MkDir ThisWorkbook.Path & "\" & Range("b6").Value & " " & Date
End If

'Koden der danner filen
ThisWorkbook.SaveAs ThisWorkbook.Path & "\" & Range("b6").Value & " " & Date
end Sub

Meningen er at den skal lave en mappe (og det gør den) og så gemme filen (SaveAs) i den nye mappe. Det gør den selvfølgelig ikke når jeg bruger ThisWorkBook.Path eftersom at den åbne fil ligger i den mappe hvor den nye mappe er dannet. Men hvad skal koden så hedde for at få den til at gemme i den nye mappe??

På forhånd tak :-)
Avatar billede Jan Hansen Ekspert
07. oktober 2019 - 16:19 #1
Hej

Prøv noget ala:

Private Sub GemSom_Click()
' laver 2 tekst-variable
Dim Sti as String
Dim FilName as Stirng

' tildeler indhold til variablene
Sti=ThisWorkbook.Path & "\" & Range("b6").Value & " " & Date
FilName=ThisWorkbook.Name

kode der danner mappen:
If Dir(Sti, vbDirectory) = "" Then
        MkDir Sti
End If

'Koden der danner filen
ThisWorkbook.SaveAs Sti & "\" & FilName

End Sub
Avatar billede joergensenmartin Juniormester
08. oktober 2019 - 08:27 #2
Kanon tak for det :-)

Rettede et par stavefejl der gav en error og så filnavnet og så virker det :-)
Avatar billede Jan Hansen Ekspert
08. oktober 2019 - 08:42 #3
ups, hjernen hurtigere end hånden ;-)
Avatar billede joergensenmartin Juniormester
08. oktober 2019 - 11:25 #4
Måske du kan svare mig på noget nyt jeg er rendt ind i?

Efter at jeg har brugt din kode, så er det jo den nye fil der er åben. Jeg har endnu en macro der skal gemme en PDF. Den virker ikke i den nye fil før jeg har haft lukket regnearket og åbnet det igen???
Avatar billede Jan Hansen Ekspert
08. oktober 2019 - 12:40 #5
tror noget ala dette vil hjælpe dig

Option Explicit
Private Sub GemSom_Click()

Dim Wb As Workbook
Dim NewWb As Workbook
Dim Ws As Worksheet
Dim TempWs As Worksheet

' laver 2 tekst-variable
Dim Sti As String
Dim FilName As String

' tildeler indhold til variablene
Set Wb = ThisWorkbook
Sti = Wb.Path & "\" & Range("b6").Value & " " & Date
FilName = ThisWorkbook.Name
'Laver ny workbook og kopierer ark over
Set NewWb = Application.Workbooks.Add
Set TempWs = NewWb.Sheets(1)
For Each Ws In Wb.Sheets
    Ws.Copy before:=TempWs
Next
With Application
    .DisplayAlerts = False
        TempWs.Delete
    .DisplayAlerts = True
End With
'kode der danner mappen:
If Dir(Sti, vbDirectory) = "" Then
        MkDir Sti
End If

'Koden der danner filen
NewWb.SaveAs Sti & "\" & FilName
NewWb.Close

End Sub


Jan
Avatar billede joergensenmartin Juniormester
08. oktober 2019 - 14:51 #6
Den laver en masse, men den danne ikke en ny mappe?
Avatar billede Jan Hansen Ekspert
08. oktober 2019 - 15:36 #7
Det er meningen at den skal lave et nyt projekt som alle ark kopieres over i for derefter at gemme den mappe som derefter lukkes så du står i den oprindelige mappe, så du kan køre din makro:

Prøv denne kode ellers tror jeg ikke jeg kan knække den!!

Option Explicit
Private Sub GemSom_Click()

Dim Wb As Workbook, NewWb As Workbook
Dim Ws As Worksheet, TempWs As Worksheet

' laver 2 tekst-variable
Dim Sti As String
Dim FilName As String

' tildeler indhold til variablene
Set Wb = ThisWorkbook
Sti = ThisWorkbook.path & "\" & Range("b6").Value & " " & Date
FilName = ThisWorkbook.Name

MsgBox "Er denne sti rigtig?  " & Sti 'til test

'kode der danner mappen:
If Dir(Sti, vbDirectory) = "" Then
        MkDir Sti
End If

'Laver ny workbook og kopierer ark over
Set NewWb = Application.Workbooks.Add
Set TempWs = NewWb.Sheets(1)
For Each Ws In Wb.Sheets
    Ws.Copy before:=TempWs
Next
With Application
    .DisplayAlerts = False
        TempWs.Delete
    .DisplayAlerts = True
End With

'Koden der danner filen
NewWb.SaveAs Sti & "\" & FilName
NewWb.Close

End Sub
Avatar billede joergensenmartin Juniormester
10. oktober 2019 - 08:13 #8
Du skal have mange tak for hjælpen. Jeg holder mig til første løsning. Jeg har bare lagt en Application.Quit ind til sidst. Så er brugeren tvunget til at åbne det igen hvis de ikke er færdige med at bruge det :-)
Avatar billede Jan Hansen Ekspert
10. oktober 2019 - 08:40 #9
Velbekomme
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
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

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