Export a query and ask for a file name

[marleyuk]

Ive compiled some code to import a file, run a query then export it to a file that the user chooses a name for. The problem is.. it doesnt work. The file imports, the queries are run, but once the user is prompted for a name something goes wrong and the wrong name is assigned to the file. Also the queries fail to be saved.

I'll attach the database and some test data to this post.

 

[marleyuk]

My test data was too big so ill just post the code from the db.


im trying to get the statement in this sub:

Private Sub Command3_Click()

 Dim strFilter As String
 Dim lngFlags As Long
 Dim strInputFilename As String
 Dim ReturnResult As String
 Dim strMsg As String
 
 
 strFilter = ahtAddFilterItem(strFilter, "Infoworks Files (*.csv)", "*.CSV")
 strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*")
 
 ReturnResult = ahtCommonFileOpenSave(InitialDir:="C:\", _
 Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
 DialogTitle:="Please select your Infoworks file")

 DoCmd.TransferText acImportDelim, "", "tblStagingTable", ReturnResult, True, ""
 
 Call InsertData("tblStagingTable", "tblImportTableTest")

 DoCmd.OpenQuery "TotalNumberOfTimesteps"
 
 strMsg = "Please enter a name for the file to be saved as "
 pFilename = InputBox(Prompt:=strMsg, _
 Title:="File namer", XPos:=2000, YPos:=2000)
 
 ExportDelimitedText "TotalNumberOfTimesteps", pFilename
  
End Sub

To run the process in this sub:

Sub ExportDelimitedText( _
   pRecordsetName As String, _
   pFilename As String, _
   Optional pBooIncludeFieldnames As Boolean, _
   Optional pBooDelimitFields As Boolean, _
   Optional pFieldDeli As String)

      'BASIC USEAGE
        '  ExportDelimitedText "QueryName", "c:\path\filename.csv"
  
   'set up error handler
   On Error GoTo ExportDelimitedText_error
   
   Dim mPathAndFile As String, mFileNumber As Integer
   Dim r As Recordset, mFieldNum As Integer
   Dim mOutputString As String
   Dim booDelimitFields As Boolean
   Dim booIncludeFieldnames As Boolean
   Dim mFieldDeli As String

   booDelimitFields = Nz(pBooDelimitFields, False)
   booIncludeFieldnames = Nz(pBooIncludeFieldnames, False)
   
   'make the delimiter a TAB character unless specified
   If Nz(pFieldDeli, "") = "" Then
      mFieldDeli = Chr(9)
   Else
      mFieldDeli = pFieldDeli
   End If
   
   'if there is no path specfied, put file in current directory
   If InStr(pFilename, "\") = 0 Then
      mPathAndFile = CurrentProject.Path
   Else
      mPathAndFile = ""
   End If
   
   mPathAndFile = mPathAndFile & "\" & pFilename

   'if there is no extension specified, add TXT
   If InStr(pFilename, ".") = 0 Then
      mPathAndFile = mPathAndFile & ".txt"
   End If
   
   'get a handle
   mFileNumber = FreeFile
   
   'close file handle if it is open
   'ignore any error from trying to close it if it is not
   On Error Resume Next
   Close #mFileNumber
   On Error GoTo ExportDelimitedText_error
   
   'delete the output file if already exists
   If Dir(mPathAndFile) <> "" Then
      Kill mPathAndFile
      DoEvents
   End If
   
   'open file for output
   Open mPathAndFile For Output As #mFileNumber
   
   'open the recordset
   Set r = CurrentDb.OpenRecordset(pRecordsetName)
   
   'write fieldnames if specified
   If booIncludeFieldnames Then
      mOutputString = ""
      For mFieldNum = 0 To r.Fields.Count - 1
         If booDelimitFields Then
             mOutputString = mOutputString & """" _
               & r.Fields(mFieldNum) & """" & mFieldDeli
            Else
               mOutputString = mOutputString _
                  & r.Fields(mFieldNum).Name & mFieldDeli
            End If
      Next mFieldNum
      
      'remove last delimiter
      mOutputString = Left(mOutputString, Len(mOutputString) - Len(mFieldDeli))
      
      'write a line to the file
      Print #mFileNumber, mOutputString
   End If
   
   'loop through all records
   Do While Not r.EOF()
   
      'tell OS (Operating System) to pay attention to things
      DoEvents
      mOutputString = ""
      For mFieldNum = 0 To r.Fields.Count - 1
         If booDelimitFields Then
            Select Case r.Fields(mFieldNum).Type
               'string
               Case 10, 12
                  mOutputString = mOutputString & """" _
                     & r.Fields(mFieldNum) & """" & mFieldDeli
               'date
               Case 8
                  mOutputString = mOutputString & "#" _
                     & r.Fields(mFieldNum) & "#" & mFieldDeli
               'number
               Case Else
                  mOutputString = mOutputString _
                     & r.Fields(mFieldNum) & mFieldDeli
            End Select
         Else
            mOutputString = mOutputString & r.Fields(mFieldNum) & mFieldDeli
         End If
         
      Next mFieldNum
      
      'remove last TAB
      mOutputString = Left(mOutputString, Len(mOutputString) - Len(mFieldDeli))
      
      'write a line to the file
      Print #mFileNumber, mOutputString
         
      'move to next record
      r.MoveNext
   Loop

   'close the file
   Close #mFileNumber
   
   'close the recordset
   r.Close
   
   'release object variables
   Set r = Nothing
   
   MsgBox "Done Creating " & mPathAndFile, , "Done"
   
   
   Exit Sub
   
'ERROR HANDLER
ExportDelimitedText_error:
   MsgBox Err.Description, , "ERROR " & Err.Number & "   ExportDelimitedText"
   'press F8 to step through code and correct problem
   Stop
   Resume
End Sub

This should be calling the variable 'pFilename' from the 2nd sub and running that process but im just getting errors like Byref arguement type mismatch. Anyone spot why?

Thanks,
Marley

 

[Brian1960]

Try changing the name of the initial file name input so that it is not the same as in the sub process ExportDelimitedText

pFilename = InputBox(Prompt:=strMsg, _
Title:="File namer", XPos:=2000, YPos:=2000)

to
Try changeing the same of the initial file name input.

 strRequiredFilename = InputBox(Prompt:=strMsg, _
 Title:="File namer", XPos:=2000, YPos:=2000)

then

ExportDelimitedText "TotalNumberOfTimesteps", strRequiredFilename

Other toughts would be. Is there a file extension in the name given. Try hard coding the name. and Where does it break?

 

[marleyuk]

lo mate, thanks for the reply.


I believe it breaks here.

ExportDelimitedText "TotalNumberOfTimesteps", strRequiredFilename

I followed your advice and changed the code and got the same error. The file extension doesnt need to be given because sub 2 states that if no extension is given, it should default to .txt.

Also I added a variable to sub1

Dim strRequiredFilename As String

When i do this I still get an error (error 13 - type mismatch) but a file is saved with the name i enter, it just doesnt contain my query, its blank.

 

[ghudson]

Why not use the Access built-in Transfertext() function? Search the Access VBA help files for more info and examples.