Modules: Exporting an Excel worksheet as a CSV file

     Often times it's necessary to use Excel to format raw data files being exported from mainframe databases.  Once the proper formatting is applied, the file can then be imported into Access as a native table.  But in most cases, such files contain a large number of records, and creating local tables might not always be feasible, especially if you need to have reporting (read only) capabilities on the data.

    Excel can be used to save a worksheet as a CSV file which can then be linked through Access using the Text ISAM drivers.  However, Excel doesn't always wrap the cell values with quotes when saving to a CSV file (a number implies that it will be written without the quotes).  Therefore it's necessary to go through all the columns and rows of the worksheet and write out the data file using VBA functions.

    Here's a generic function which accepts a reference to an Excel worksheet (which you would have opened through Automation) and the path to a destination CSV file.  It can be called from your code like this

  With objXL
    .Visible = True
    .Workbooks.OpenText FileName:=strFile, Origin:= _
        xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, _
        Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 2), _
        Array(2, 2), Array(3, 2), Array(4, 2))
    
    Set objWkb = .Workbooks(1)
     
   Call fExportCommaDelimitedFile(objWkb.Worksheets(1), fFileDir(strFile) & _
            fFileName(Dir(strFile)) & ".csv")

'*********************** Code Start ***************************
'This code was originally written by Dev Ashish
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Function fExportCommaDelimitedFile(objSht As excel.Worksheet, _
                              strDestinationFile As String) _
                                As Boolean
'*******************************************
'Name:      fExportCommaDelimitedFile (Function)
'Purpose:  Writes a worksheet out as a CSV file
'Author:    Dev Ashish
'Date:        March 10, 1999, 12:21:10 PM
'Called by: Any
'Calls:        sAppActivate
'Inputs:      objSht - Excel Worksheet opened previously through Automation
'                 strDestinationFile - Path to destination CSV file
'Output:    True on Success, false otherwise
'*******************************************
Dim intFileNum As Integer
Dim lngColCount As Long
Dim lngTotalColumns As Long
Dim lngTotalRows As Long
Dim lngRowCount As Long
Const conQ = """"
Const conERR_GENERIC = vbObjectError + 2100

  intFileNum = FreeFile()
  On Error GoTo ErrHandler
  
  'Activate Access instance
  Call sAppActivate
  
  'If the target file exists, confirm that it should be deleted
  If Len(Dir(strDestinationFile)) > 0 Then
    If MsgBox("The target file specified " & vbCrLf & vbCrLf _
        & strDestinationFile & vbCrLf & vbCrLf & " already exists." _
        & vbCrLf & vbCrLf & "Are you sure you want to overwrite it?", _
        vbQuestion + vbYesNo, "Please confirm") = vbYes Then
          Kill strDestinationFile
    Else
      Err.Raise conERR_GENERIC
    End If
  End If
   
  'Create the CSV file
  Open strDestinationFile For Output As #intFileNum
         
  With objSht
    'Determine total number of columns
    lngTotalColumns = .UsedRange.Columns.Count
    'Determine total number of rows
    lngTotalRows = .UsedRange.Rows.Count
    'Initialize the progress meter
    Call SysCmd(acSysCmdInitMeter, "Writing CSV file...", lngTotalRows)
    
    'Go through all the rows
    For lngRowCount = 1 To lngTotalRows
      ' Loop through each column
      For lngColCount = 1 To lngTotalColumns
        ' Write current cell's text to file with quotation marks.
        Print #intFileNum, conQ & RTrim$(.Cells(lngRowCount, lngColCount).Value) & conQ;
        ' Check if cell is in last column.
        If lngColCount = lngTotalColumns Then
          'the end
          Print #intFileNum,
        Else
          ' Otherwise, write a comma.
          Print #intFileNum, ",";
        End If
      Next lngColCount
      Call SysCmd(acSysCmdUpdateMeter, lngRowCount)
      'No need to hog the CPU for large worksheets
      DoEvents
    Next lngRowCount
  End With
  fExportCommaDelimitedFile = True
ExitHere:
  On Error Resume Next
  Call SysCmd(acSysCmdRemoveMeter)
  Close #intFileNum
  Exit Function
ErrHandler:
  fExportCommaDelimitedFile = False
  Resume ExitHere
End Function

Private Sub sAppActivate()
'Activate the Access instance
'
Dim strCaption As String
  On Error Resume Next
  strCaption = Application.CurrentDb.Properties("AppTitle")
  If Err Then strCaption = "Microsoft Access"
  AppActivate strCaption
End Sub
'*********************** Code End ***************************