• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Nieuw bestand opslaan op locatie

Status
Niet open voor verdere reacties.
S

Siep26

Gebruiker
Lid geworden
15 sep 2017
Berichten
71
Hi,

Ik heb een macro gemaakt, waarbij ik twee sheets samenvoeg als nieuw bestand en ergens op sla. Echter met deze code wordt het nieuwe bestand in mijn documenten opgeslagen. Ik wil daar graag een specifieke folder voor kiezen. Kan iemand mij hiermee helpen?

Code: 
Sub NieuwBestand()
    Dim Fname As String, ws As Worksheet
    Fname = Sheets("Verzenden").Range("F1").Value
    Sheets(Array("Export", "Draaitabel")).Copy
    With ActiveWorkbook
    .SaveAs Filename:=Fname
    .Close
End With
End Sub
 
Wil je die locatie kiezen of is het een vaste locatie?
 
Hier wordt om een folder gevraagd, maar de variabele Pad kan je ook vervangen door een vaste waarde:
Code: 
Sub NieuwBestand()
    Dim Pad As String
    Dim Fname As String, ws As Worksheet

    Pad = GetFolder
    Fname = Pad & "\" & Sheets("Verzenden").Range("F1").Value
    Sheets(Array("Export", "Draaitabel")).Copy
    With ActiveWorkbook
        .SaveAs Filename:=Fname
        .Close
    End With
End Sub

Function GetFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show = -1 Then sItem = .SelectedItems(1)
    End With
    GetFolder = sItem
    Set fldr = Nothing
End Function
 
Bedankt zover. Ik krijg alleen onderstaande foutmeldingen.
2018-04-24 10_31_47-18. Controle bemiddelingskosten (Gosja Pomoc) TEST - Opgeslagen.png2018-04-24 10_32_07-Microsoft Visual Basic for Applications - 18. Controle bemiddelingskosten (G.png

F1 niet gevuld in het nieuwe bestand, maar hij moet de naam uit cel F1 uit het oorspronkelijk bestand pakken.

Mij is niet duidelijk wat ik precies dien aan te passen voor een vaste locatie.
 
En heb je in dat document wel een blad met de naam Verzenden?

Voor een vaste locatie wijzig je:
Pad = GetFolder

In bijvoorbeeld:
Pad = "C:\Users\Siep26\Documenten"
 
Laatst bewerkt:
edmoor zei:
En heb je in dat document wel een blad met de naam Verzenden?

Voor een vaste locatie wijzig je:
Pad = GetFolder

In bijvoorbeeld:
Pad = "C:\Users\Siep26\Documenten"
Klik om te vergroten...

Oké, niet slim van mij. Had de naam aangepast naar Macro, maar krijg nu deze melding.
2018-04-24 10_42_07-Microsoft Visual Basic for Applications - 18. Controle bemiddelingskosten (G.png2018-04-24 10_42_22-Microsoft Visual Basic for Applications - 18. Controle bemiddelingskosten (G.png
 
Dan klopt de naam van het document dat je wilt opslaan niet.
 
Dat lijkt me toch duidelijk.
De variabele Fname heeft dan een onjuiste waarde.
 
edmoor zei:
Dat lijkt me toch duidelijk.
De variabele Fname heeft dan een onjuiste waarde.
Klik om te vergroten...

Ik heb de fout gevonden in F1 staat deze formule. En dat pakt ie niet. Als ik daar gewoon harde tekst type werkt de macro wel.
Er stond een dubbel punt in de cel. Fout opgelost

Thanks!

Mag ik vragen waar je deze kennis hebt opgedaan? Heb je een cursus of boek dat je aanraadt? Ik wil me hier ook in verdiepen (en dan niet perse de wiskundige/formules kant van macro's)
 
Laatst bewerkt:
Wat betreft VBA zelf kan je hier prima terecht:
https://www.excel-pratique.com/en/vba.php

Het onderkennen van probleem oorzaken is een kwestie van ervaring en weten wat hoe de foutcodes te interpreteren.
 
Is het ook mogelijk om een dialoogvenster te krijgen om het bestand op te snlaan en om daar ook nog de naam van het bestand en locatie aan te passen?
 
Dat kan zo:
Code: 
Sub NieuwBestand()
    Dim Fname As String, ws As Worksheet

    Fname = GetFileName
    Sheets(Array("Export", "Draaitabel")).Copy
    With ActiveWorkbook
        .SaveAs Filename:=Fname
        .Close
    End With
End Sub

Function GetFileName()
    fileSaveName = Application.GetSaveAsFilename(fileFilter:="Excel bestanden (*.xls*), *.xls*")
    If fileSaveName <> False Then
        GetFileName = fileSaveName
    End If
End Function
 
Alweer bedankt!

Nog een vraag:
edmoor zei:
En heb je in dat document wel een blad met de naam Verzenden?

Voor een vaste locatie wijzig je:
Pad = GetFolder

In bijvoorbeeld:
Pad = "C:\Users\Siep26\Documenten"
Klik om te vergroten...

Is het ook mogelijk om het bestand op twee locatie in 1x op te slaan? De macro twee keer er inzetten werkt niet.
 
Tuurlijk. Met:
Pad1= GetFolder

En:
Pad2 = GetFolder
 
Hi,

Ik heb nu deze code
Code: 
Sub ExportOpslaan()
    Dim Pad As String
    Dim Fname As String, ws As Worksheet

    Pad1 = "H:\Siep26"
    Pad2 = "G:\Siep26"
    Fname = Pad1 & "\" & Sheets("Macro").Range("F1").Value
    Fname = Pad2 & "\" & Sheets("Macro").Range("F1").Value
    Sheets(Array("Export", "Draaitabel")).Copy
    With ActiveWorkbook
        .SaveAs Filename:=Fname
        .Close
    End With
End Sub
Function GetFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show = -1 Then sItem = .SelectedItems(1)
    End With
    GetFolder = sItem
    Set fldr = Nothing
End Function

Maar nu slaat ie hem alleen op Pad2 op.
 
Logisch. Als je 2x wilt opslaan moet je dat ook 2x doen uiteraard:
Code: 
Sub ExportOpslaan()
    Dim Fname1 As String
    Dim Fname2 As String
    Dim ws As Worksheet

    Fname1 = "H:\Siep26\" & Sheets("Macro").Range("F1").Value
    Fname2 = "G:\Siep26\" & Sheets("Macro").Range("F1").Value
    Sheets(Array("Export", "Draaitabel")).Copy

    ActiveWorkbook.SaveAs Filename:=Fname1

    With ActiveWorkbook
        .SaveAs Filename:=Fname2
        .Close
    End With
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan