Hello!
I'm new here.
Question.
I have te following code to export mij Query to excell.
It works fine but, i'd like it this way:
Open an existing excel file (for example c.xls) and put my output in there and then rename c.xls to Format(Date, "YYYYMMDD") & "_Compensatie_" & ".xls".
Help Anyone?
Greetz
Gaatse
p.s. here is the code
---------------------
Private Sub export_Click()
Dim strWaar As String
Dim DBpad, bestand, Pad As String
Dim j As Integer
Dim strQryName As String
Dim strSQL As String
Dim strExcelFile As String
Dim strWorksheet As String
bestand = Format(Date, "YYYYMMDD") & "_Compensatie_" & ".xls"
strQryName = "Feiten"
strSQL = "SELECT * FROM Feiten"
Dim MyName
Dim Bestaat As Integer
For j = Len(Application.CurrentDb.Name) To 1 Step -1
If Mid(Application.CurrentDb.Name, j, 1) = "\" Then
Pad = Left(Application.CurrentDb.Name, j)
MyName = Dir(Pad, vbDirectory)
Do While MyName <> ""
If MyName <> "." And MyName <> ".." Then
If (GetAttr(Pad & MyName) And vbDirectory) = vbDirectory Then
If (Pad & MyName) = Left(Application.CurrentDb.Name, j) & "Exports" Then
Bestaat = 1
Exit Do
End If
End If
End If
MyName = Dir
Loop
If Bestaat = 0 Then MkDir Left(Application.CurrentDb.Name, j) & "Exports\"
Pad = Left(Application.CurrentDb.Name, j) & "Exports\"
Exit For
End If
Next j
With Application.FileSearch
.LookIn = Pad
.SearchSubFolders = False
.FileName = bestand
.MatchTextExactly = True
If .Execute() > 0 Then
MsgBox "U moet de oude export eerst verwijderen of verplaatsen voor u een nieuwe export kunt maken" & (Chr(10)) _
& (Chr(10)) _
& "U vind de oude export in " & Pad, vbCritical, "Export bestaat al"
Else
DoCmd.OutputTo acOutputQuery, strQryName, acFormatXLS, Pad & bestand
MsgBox "De export is succesvol uitgevoerd" & (Chr(10)) _
& (Chr(10)) _
& "U vind de export in " & Pad & bestand, vbInformation, "Export Naar Excel Voltooid"
End If
End With
Exit_Sub:
strWaar = Empty
Exit Sub
Err_btnExport_Click:
strWaar = Empty
End Sub
---------------------
I'm new here.
Question.
I have te following code to export mij Query to excell.
It works fine but, i'd like it this way:
Open an existing excel file (for example c.xls) and put my output in there and then rename c.xls to Format(Date, "YYYYMMDD") & "_Compensatie_" & ".xls".
Help Anyone?
Greetz
Gaatse
p.s. here is the code
---------------------
Private Sub export_Click()
Dim strWaar As String
Dim DBpad, bestand, Pad As String
Dim j As Integer
Dim strQryName As String
Dim strSQL As String
Dim strExcelFile As String
Dim strWorksheet As String
bestand = Format(Date, "YYYYMMDD") & "_Compensatie_" & ".xls"
strQryName = "Feiten"
strSQL = "SELECT * FROM Feiten"
Dim MyName
Dim Bestaat As Integer
For j = Len(Application.CurrentDb.Name) To 1 Step -1
If Mid(Application.CurrentDb.Name, j, 1) = "\" Then
Pad = Left(Application.CurrentDb.Name, j)
MyName = Dir(Pad, vbDirectory)
Do While MyName <> ""
If MyName <> "." And MyName <> ".." Then
If (GetAttr(Pad & MyName) And vbDirectory) = vbDirectory Then
If (Pad & MyName) = Left(Application.CurrentDb.Name, j) & "Exports" Then
Bestaat = 1
Exit Do
End If
End If
End If
MyName = Dir
Loop
If Bestaat = 0 Then MkDir Left(Application.CurrentDb.Name, j) & "Exports\"
Pad = Left(Application.CurrentDb.Name, j) & "Exports\"
Exit For
End If
Next j
With Application.FileSearch
.LookIn = Pad
.SearchSubFolders = False
.FileName = bestand
.MatchTextExactly = True
If .Execute() > 0 Then
MsgBox "U moet de oude export eerst verwijderen of verplaatsen voor u een nieuwe export kunt maken" & (Chr(10)) _
& (Chr(10)) _
& "U vind de oude export in " & Pad, vbCritical, "Export bestaat al"
Else
DoCmd.OutputTo acOutputQuery, strQryName, acFormatXLS, Pad & bestand
MsgBox "De export is succesvol uitgevoerd" & (Chr(10)) _
& (Chr(10)) _
& "U vind de export in " & Pad & bestand, vbInformation, "Export Naar Excel Voltooid"
End If
End With
Exit_Sub:
strWaar = Empty
Exit Sub
Err_btnExport_Click:
strWaar = Empty
End Sub
---------------------