Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

VBA Acces - Export excel

Status
Not open for further replies.

Gaatsen

Technical User
Jun 16, 2008
5
NL
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

---------------------
 



Hi,

Check out Name oldpathname As newpathname

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
That is just renaming the file.

First i need to open c.xls

and put my output sheet in it

then rename it.

Could you code that for me?
 




"Could you code that for me?"

Tek-Tips is not a free coding service. It is a place where professionals share information.

Exactly what problems do you have with the code you posted?


Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Never mind, i have te code


strSQL = "SELECT * INTO [Excel 8.0;Database=" & Pad & strQryName & ".xls].[" & strQryName & "] FROM " & strQryName & ";"
CurrentDb.Execute strSQL
'Rename File after export
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top