extra versie maken als file exisists

[Lisett]

Ik durf het bijna niet meer te vragen! Maar ik ben weer vast gelopen. Ik wil nu voor elkaar krijgen dat als ik een bestand opsla, er wordt gecheckt of deze al bestaat, en als die bestaat dat er dan een (1) achter komt.
Ik heb al gelezen over een loopje die dit voor elkaar kan krijgen maar ik weet zelf niet zo goed hoe ik moet beginnen. Dit is de code die zorgt dat het wordt opgeslagen.

Function HerinneringOpslaan()
    Dim stsPath As String

    With Sheets("Herinnering Opstellen")
        stsPath = ActiveWorkbook.Path & "\Herinneringen\"
        stsPath = stsPath & "Herinneringen" & Space(1) & MaandNaam(Month(Now)) & "-" & Year(Now)
        With CreateObject("Scripting.FileSystemObject")
             If Not .FolderExists(stsPath) Then .CreateFolder stsPath
        End With
.ExportAsFixedFormat 0, stsPath & "\Herinnering " & .Range("F31") & ".pdf", , 1
    End With
End Function

 

[snb]

if dir("G:\of\voorbeeld.xlsx")<>"" then activeworkbook.saveas "G:\of\voorbeeld(1).xlsx",51

 

[Lisett]

Hoe implementeer ik dat in mijn huidige code? Ik gebruik namelijk Activeworkbook.path. Als ikActiveWorkbook.Path & "\Herinneringen\" & "Herinneringen" & Space(1) & MaandNaam(Month(Now)) & "-" & Year(Now) & "\Herinnering " & .Range("F31") & ".pdf" probeer in te vullen krijg ik veel fout meldingen....

 

[snb]

Het is in plaats van je huidige code.

 

[edmoor]

Probeer deze eens. Als 'ie naar je zin werkt gaan we er een loopje inbouwen om het juiste nummer op te halen waar nu (1) wordt gebruikt:

Sub HerinneringOpslaan()
    Dim stsPath As String
    Dim stsFile As String
    Dim NewFolder As Boolean

    stsPath = ActiveWorkbook.Path & "\Herinneringen\" & "Herinneringen " & MonthName(Month(Date)) & "-" & Year(Date)
    With Sheets("Herinnering Opstellen")
        stsFile = "\Herinnering " & .Range("F31") & ".pdf"
        With CreateObject("Scripting.FileSystemObject")
            If Not .FolderExists(stsPath) Then
                .CreateFolder stsPath
                NewFolder = True
            End If
        End With
        
        If Not NewFolder Then
            If Dir(stsPath & stsFile) <> "" Then
                stsFile = "\Herinnering " & .Range("F31") & "(1).pdf"
            End If
        End If
       .ExportAsFixedFormat 0, stsPath & stsFile, , 1
    End With
End Sub

Tevens heb ik er een Sub van gemaakt omdat een Function niet echt zin had.

 

[Lisett]

De sub werkt super! Nu komt er alleen een ander probleem naar voren. Hiervoor had ik erin staan dat ik een melding kreeg als het nummer al bestond met de vraag of je het over wilde schrijven. Als je nee tikte, dan stopte de sub, als je ja klikte, dan werd hij dus overgeschreven.

      Set Cel = .Columns(VerzamelHerFactuurnummerKolom).Find(FactNo, LookIn:=xlValues)
      If Cel Is Nothing Then
        Set Cel = .Cells(LastInColumn(.Columns(VerzamelHerFactuurnummerKolom)) + 1, VerzamelHerFactuurnummerKolom)
      Else
        If MsgBox("Factuurnummer: " & Format(FactNo, "#,##0") & " bestaat al Overschrijven!", vbCritical + vbYesNo, "Dubbel Factuurnummer") = vbNo Then Exit Sub
        
      End If

Maar ik dacht deze even simpel te kunnen verwijderen maar dan werkt mijn offset property niet meer (foutmelding dat opbjectvariabele with niet is ingesteld.

With .Cells(Cel.Row, Cel.Column)

Ik zie dat .Cells ervoor ook al is genoemd, dus dat het waarschijnlijk daar ergens mee te maken heeft. Nu dacht ik slim te zijn en de set Cel te laten staan, maar helaas, dit werkt ook niet. Ik heb echt het vermoeden dat dit vrij simpel is, maar ik zie het niet.

 

[edmoor]

Maar wat is nu de bedoeling? Wil je een vraag krijgen of het bestand overscheven mag worden of wil je hem opslaan met een nieuw nummer?

 

[Lisett]

Die vraag of het overgeschreven mag worden wil ik graag vervangen door het bestand op te slaan met bijvoorbeeld (1) erachter.

 

[edmoor]

En als die (1) ook al bestaat moet het (2) worden enzovoort?

 

[Lisett]

juist!

 

[edmoor]

Ok. Probeer deze dan maar eens:

Sub HerinneringOpslaan()
    Dim stsPath As String
    Dim stsFile As String
    Dim NewFolder As Boolean
    Dim Versie As Integer

    stsPath = ActiveWorkbook.Path & "\Herinneringen\" & "Herinneringen " & MonthName(Month(Date)) & "-" & Year(Date)
    With Sheets("Herinnering Opstellen")
        stsFile = "\Herinnering " & .Range("F31") & ".pdf"
        With CreateObject("Scripting.FileSystemObject")
            If Not .FolderExists(stsPath) Then
                .CreateFolder stsPath
                NewFolder = True
            End If
        End With
        
        If Not NewFolder Then
            If Dir(stsPath & stsFile) <> "" Then
                stsFile = "\Herinnering " & .Range("F31") & "(0).pdf"
                Versie = VersieNummer(stsPath & stsFile)
                stsFile = "\Herinnering " & .Range("F31") & "(" & Versie & ").pdf"
            End If
        End If
       .ExportAsFixedFormat 0, stsPath & stsFile, , 1
    End With
End Sub

Function VersieNummer(Bestand As String) As Integer
    Dim i As Integer
    Dim Part1 As String
    Dim Part2 As String
    Part1 = Mid(Bestand, 1, InStr(1, Bestand, "("))
    Part2 = Right(Bestand, 5)
    
    i = 1
    While Dir(Part1 & i & Part2) <> ""
        i = i + 1
    Wend
    VersieNummer = i
End Function

Een Sub en een Function dus.

 

[Lisett]

Doet het perfect! Dankjewel! Ik ga nog aan de slag met die melding icm n offset, hopelijk kom ik eruit, en anders hoor je wel weer van me

 

[edmoor]

Ok dan. Veel plezier ermee

 

[Lisett]

Het is me gelukt! Bedankt voor alle hulp!