Opslaan. Bestaat die file al? Voeg dan (1), (2) etc toe

Status
Niet open voor verdere reacties.

Visara

Gebruiker
Lid geworden
10 mrt 2019
Berichten
217
Goedemiddag,

Met macro iets opslaan vanuit Access als Naam.xlsx (lukt me, zie code hier onder)
Mijn wens: als de excel-naam al bestaat (Runtime Error 2302), sla het bestand dan op als:
Naam.xlsx
Naam(1).xlsx
Naam(2).xlsx
etc
Andere suggesties zijn ook welkom, als het bestand maar een unieke toevoeging krijgt.

Code:
Private Sub cmdLessenNaarExcelBetweenDates_Click()
    DoCmd.OutputTo acOutputQuery, "Naamvandequery", acFormatXLSX, "c:\Test\Naam.xlsx"
End Sub

Met vriendelijke (verkoelende) groet, Visara
 
Gebruik Dir om te checken of het bestand al bestaat. Verander in dat geval de bestandsnaam in de output.
 
Bedankt voor de richting, dan kan ik gericht zoeken.

Dit heb ik so far, maar gaat nog niet goed.

Code:
Private Sub cmdLessenNaarExcelBetweenDates_Click()

Dim n As String
Dim FileName As String
n = 1

FileName = VBA.FileSystem.Dir("c:\Test\LessenMetGekozenData" & n)

If FileName = VBA.Constants.vbNullString Then
DoCmd.OutputTo acOutputQuery, "qLessenGevolgdVoorReport", acFormatXLSX, "c:\Test\LessenMetGekozenData" & n

Else
n = n + 1
DoCmd.OutputTo acOutputQuery, "qLessenGevolgdVoorReport", acFormatXLSX, "c:\Test\LessenMetGekozenData" & n

End If
End Sub

Gaat nog niet goed. Het wordt niet opgeslagen als .xlsx en ik moet er nog een loop van maken. Die loop, daar kom ik denk ik wel uit (gaat mijn eerste keer worden)
Ik probeerde in de CoCmd-regel dingen als '& .xlsx' te plakken en de " " op verschillende plekken te plaatsen, maar werkt niet.
Kunt u me laten zien hoe dat moet?
 
Probeer het eens met een functie:
Code:
Private Sub cmdLessenNaarExcelBetweenDates_Click()
    DoCmd.OutputTo acOutputQuery, "Naamvandequery", acFormatXLSX, GenereerNaam("C:\Test\", "Naam", "xlsx")
End Sub

Function GenereerNaam(Pad As String, Naam As String, Ext As String) As String
    If Dir(Pad & "\" & Naam & "." & Ext) = "" Then
        GenereerNaam = Pad & "\" & Naam & "." & Ext
        Exit Function
    End If
    
    i = 1
    While Dir(Pad & "\" & Naam & "(" & i & ")." & Ext) <> ""
        i = i + 1
    Wend
    GenereerNaam = Pad & "\" & Naam & "(" & i & ")" & "." & Ext
End Function
 
En kan je in ieder project zo weer gebruiken :)
 
Ja, precies :) Dat is het mooie van dat soort algemene codes.
Mijn 'gereedschapskist' wordt steeds groter door dit soort kant-en-klare codes te vinden/krijgen in combinatie met handige websites en youtube-filmpjes.
 
Haha, zeker een handige website :) Jij hebt me al meerdere keren heel fijn geholpen. Veel aardige mensen hier.
Ik probeer het eerst zelf hoor, door zoektermen in te typen. En youtube niet te vergeten. Voor beginnersvragen is dat echt prima.
Ook zoeken binnen deze site helpt, vaak lopen mensen tegen dezelfde dingen aan.
 
Omdat het slechts om het volgnummer gaat:

Code:
Sub M_snb()
   c00 = "G:\OF\adressen(#).xlsx"
   
'   ActiveWorkbook.SaveAs Replace(c00, "#", F_snb(c00))
    DoCmd.OutputTo 1, "Query_001", acFormatXLSX, Replace(c00, "#", F_snb(c00))
End Sub

Function F_snb(c00)
   F_snb = 0
   Do Until Dir(Replace(c00, "#", F_snb) & "*") = ""
       F_snb = F_snb + 1
   Loop
End Function
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan