Hi all,
I'm having a problem with a small project im making for my parents small buisiness.
basicly, i want them to be able to hit a button and then choose a folder to export the data from queries as delimited text files.the method i was using worked fine but was limited as they couldnt choose the folder to export to. now, however i am attempting to use a folder dialog box to choose the folder. this, again works fine and the wholde cosde runs fine with no errors but when the resulting folder is opened the text files are not in there.
I stopped using the macro as was unable to get the variable (containing the path of the selected folder) from the vba module to the macro. As a result i exported the macro into the module for the code
the code for the system is as follows.
Many thanks in advance for your help.
Tommy
I'm having a problem with a small project im making for my parents small buisiness.
basicly, i want them to be able to hit a button and then choose a folder to export the data from queries as delimited text files.the method i was using worked fine but was limited as they couldnt choose the folder to export to. now, however i am attempting to use a folder dialog box to choose the folder. this, again works fine and the wholde cosde runs fine with no errors but when the resulting folder is opened the text files are not in there.
I stopped using the macro as was unable to get the variable (containing the path of the selected folder) from the vba module to the macro. As a result i exported the macro into the module for the code
the code for the system is as follows.
Code:
Private Sub BtnExport_Click()
Dim place As String
If MsgBox("Would you like to overwrite the current save Location?", vbYesNo) = vbYes Then
place = BrowseForFolder
If place = "" Then GoTo Stops
Else
MsgBox (vbDirectory)
place = vbDirectory
End If
If MsgBox("Saved to:" & vbNewLine & place & vbNewLine & vbNewLine & "Would you like to open the backup location?", vbYesNo) = vbYes Then
Call Shell("explorer.exe " & place, vbNormalFocus)
End If
McrSave
Stops:
End Sub
Function McrSave()
With CodeContextObject
DoCmd.OpenQuery "QryExportCustomers", acViewNormal, acEdit
DoCmd.OpenQuery "QryExportBooking", acViewNormal, acEdit
DoCmd.TransferText acExportDelim, "", "QryExportCustomers", place & "\BACKUP\TblCustomers " & Date$ & " " & Time$() & ".txt", True, ""
DoCmd.TransferText acExportDelim, "", "QryExportBooking", place & "\BACKUP\TblBooking " & Date$ & " " & Time$() & ".txt", True, ""
DoCmd.Close acQuery, "QryExportCustomers"
DoCmd.Close acQuery, "QryExportBooking"
End With
MsgBox ("test" & place)
McrSave_Exit:
Exit Function
End Function
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'Function purpose: To Browser for a user selected folder.
'If the "OpenAt" path is provided, open the browser at that directory
'NOTE: If invalid, it will open at the Desktop level
OpenAt = CurrentProject.Path
Dim ShellApp As Object
'Create a file browser window at the default folder
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
'Set the folder to that selected. (On error in case cancelled)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
Exit Function
Invalid:
'If it was determined that the selection was invalid, set to False
BrowseForFolder = False
End Function
Many thanks in advance for your help.
Tommy