Wie kan me verder helpen.
Ik heb een sheet gemaakt die steeds na gebruik moet worden opgeslagen in de map '2015', die ook automatisch met VBA wordt aangemaakt.
In de map '2015' wordt het excel bestand weggeschreven. De bestandsnaam wordt gehaald uit een ander tabblad binnen excel.
De eerste keer dat ik het script draai wordt er op C:\Mijn documenten netjes een map '2015' aangemaakt en daarin het bestand weggeschreven. Als ik het script weer opnieuw draai, zou het excel bestand overschreven moeten worden, maar dat gebeurd dus niet, omdat het tijdstempel hetzelfde blijft. Verwijder ik het bestand, en draai het script weer, dan wordt het bestand weer netjes weggeschreven. Wie kan mij helpen.
Ik heb een sheet gemaakt die steeds na gebruik moet worden opgeslagen in de map '2015', die ook automatisch met VBA wordt aangemaakt.
In de map '2015' wordt het excel bestand weggeschreven. De bestandsnaam wordt gehaald uit een ander tabblad binnen excel.
De eerste keer dat ik het script draai wordt er op C:\Mijn documenten netjes een map '2015' aangemaakt en daarin het bestand weggeschreven. Als ik het script weer opnieuw draai, zou het excel bestand overschreven moeten worden, maar dat gebeurd dus niet, omdat het tijdstempel hetzelfde blijft. Verwijder ik het bestand, en draai het script weer, dan wordt het bestand weer netjes weggeschreven. Wie kan mij helpen.
Code:
Private Enum saveFolders
create_year_and_subs = 0
create_pdf_xls = 1
create_pdf_only = 2
create_xls_only = 3
all_exists = 4
End Enum
Public Sub OpslaanKopie()
'' Deze functie is de hoofdoperator
'Const sPath As String = "Hier een vast path invoeren" 'is verwijzing naar vast opgegeven path.
Dim sPath As String
Dim sPathSub As String
Dim sPathSub1 As String
'Param C2 = Datum begin schooljaar
'Param C3 = Datum einde schooljaar
'Param C8 = Pathnaam
'Param C9 = Bestandsnaam
'Param C10 = Bestandsextensie
sPath = Sheets("Param").Range("C8").Value 'Verwijzing naar variable path vanuit instalgegevens
Dim sYear As String
Dim sFileName As String
Dim create As saveFolders
'' Vastleggen welk jaar het nu is in een stringvariabele:
sYear = CStr(Year(Date))
'sYear = CStr(Sheets("Param").Range("C2").Value)
''Vastleggen wat de filename is
sFileName = Sheets("Param").Range("C9").Value & "_" & Sheets("Param").Range("C2").Value & "_" & Sheets("Param").Range("C3")
'' Controleren of map 'Jaar' wel bestaat
create = doesPathExists(sPath, sYear)
If Not create = all_exists Then Call CreatePath(sPath, sYear, create)
'' Opslaan van een kopie
If doesFileExists(sPath & "\" & sYear & "\" & sFileName & ".XLSX") = False Then Call OpslagXLSX(sPath, sYear, sFileName)
MsgBox "De bestanden zijn succesvol opgeslagen op:" & vbCrLf & vbCrLf & sPath & "\" & sYear & "\" & "PDF" & vbCrLf & "onder bestandsnaam:" & vbCrLf & vbCrLf & sFileName & ".PDF" _
& vbCrLf & vbCrLf & sPath & "\" & sYear & "\" & "XLS" & vbCrLf & "onder bestandsnaam:" & vbCrLf & vbCrLf & sFileName & ".XLSX"
End Sub
'Private Sub OpslagPDF(sPath As String, sYear As String, sFileName As String)
'' Opslag PDF Macro : aangepast op 7-11-2014
'Dim wSheet As Worksheet
'Set wSheet = ActiveSheet
'' Exporteren naar een pdf
'wSheet.ExportAsFixedFormat xlTypePDF, sPath & "\" & sYear & "\PDF\" & sFileName & ".PDF"
'Set wSheet = Nothing
'End Sub
Private Sub OpslagXLSX(sPath As String, sYear As String, sFileName As String)
'' Opslag XLSX Macro : aangepast op 8-11-2014
Dim wBook As Workbook
Dim wSheet As Worksheet
Dim iSheets As Integer
'Als laatste het daadwerkelijk exporteren naar een pdf
Set wSheet = ActiveSheet
Set wBook = Workbooks.Add
iSheets = wBook.Sheets.Count
wSheet.Copy after:=wBook.Sheets(iSheets)
Application.DisplayAlerts = False
For i = 1 To iSheets
wBook.Sheets(1).Delete
Next i
wBook.SaveAs sPath & "\" & sYear & "\" & sFileName & ".XLSX", , , , False
wBook.Close
Application.DisplayAlerts = True
Set wSheet = Nothing
End Sub
Private Function doesFileExists(sFile As String) As Boolean
If Not Dir(sFile, vbNormal) = "" Then
doesFileExists = True
End If
End Function
Private Function doesPathExists(sPath As String, sYear As String) As saveFolders
'' Controleer of een pad en bijhorende subpaden bestaan
'' Als een van de paden niet bestaat, dan aanmaken
Dim sPathCheck As String
sPathCheck = sPath & "\" & sYear
'' Als het jaartal niet voorkomt, dan alles aanmaken
If Dir(sPathCheck, vbDirectory) = "" Then
doesPathExists = create_year_and_subs
Exit Function
End If
'' Als het jaartal voorkomt controleren of de subpaden er zijn
If Dir(sPathCheck & "\" & "PDF", vbDirectory) = "" And Dir(sPathCheck & "\" & "XLS", vbDirectory) = "" Then
doesPathExists = create_pdf_xls
Exit Function
End If
End Function
Private Sub CreatePath(sPath As String, sYear As String, yfCreate As saveFolders)
Select Case yfCreate
Case create_year
MkDir (sPath & "\" & sYear)
End Select
End Sub