INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

VBA Acces export to excel

VBA Acces export to excel

(OP)
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

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

RE: VBA Acces export to excel

(OP)
Can't find the answer....

RE: VBA Acces export to excel

Any reason you didn't just take my advice and post this question in the correct forum?

___________________________________________________________
If you want the best response to a question, please check out FAQ222-2244: How to get the best answers first.
'If we're supposed to work in Hex, why have we only got A fingers?'
Drive a Steam Roller
Steam Engine Prints

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close