May 14th, 2012
The following function enable you to read in, for instance a text file, into memory to use within your routines.
'---------------------------------------------------------------------------------------
' Procedure : ReadFile
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Faster way to read text file all in RAM rather than line by line
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
' Input Variables:
' ~~~~~~~~~~~~~~~~
' strFile - name of the file that is to be read
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' MyTxt = ReadText("c:\tmp\test.txt")
' MyTxt = ReadText("c:\tmp\test.sql")
' MyTxt = ReadText("c:\tmp\test.csv")
'---------------------------------------------------------------------------------------
Function ReadFile(ByVal strFile As String) As String
On Error GoTo Error_Handler
Dim FileNumber As Integer
Dim sFile As String 'Variable contain file content
'If FileExist(strFile) = False Then
' MsgBox "The specified file could not be found!"
' Exit Function
'End If
FileNumber = FreeFile
Open strFile For Binary Access Read As FileNumber
sFile = Space(LOF(FileNumber))
Get #FileNumber, , sFile
Close FileNumber
ReadFile = sFile
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ReadFile" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function |
c
Share and Enjoy
MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming | 
No Comments »
May 14th, 2012
I was asked in a support forum how to convert an Excel *.xls, *.xlsx file to *.csv format. I didn’t readily have an answer so I created a custom function to help the user out. So here are the fruits on my labors should it help someone else out. What is also nice about the way it is written, is that it will run in any MS Office application (MS Access, MS Word, MS PowerPoint, MS Outlook, …) without requiring any modifications (copy & paste, that’s it)!
'---------------------------------------------------------------------------------------
' Procedure : ConvertXls2CSV
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Converts a standard Excel file to csv format
' Requirements: Requires MS Excel be installed
' Uses late binding, so no libraries need be declared
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sXlsFile : Fully qualified path and filename with extension of the Excel workbook
'
' Usage:
' ~~~~~~
' ConvertXls2CSV "C:\Users\Daniel\Desktop\Contact_E-mail listing.xls"
' Will output a file C:\Users\Daniel\Desktop\Contact_E-mail listing.csv
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2012-May-11 Initial Release - Answer to forum question
'---------------------------------------------------------------------------------------
Function ConvertXls2CSV(sXlsFile As String)
On Error Resume Next
Dim oExcel As Object
Dim oExcelWrkBk As Object
Dim bExcelOpened As Boolean 'Was Excel already open or not
'Review 'XlFileFormat Enumeration' for more formats
Const xlCSVWindows = 23 'Windows CSV Format
Const xlCSV = 6 'CSV
Const xlCSVMac = 22 'Macintosh CSV
Const xlCSVMSDOS = 24 'MSDOS CSV
Set oExcel = GetObject(, "Excel.Application") 'Bind to existing instance of Excel
If Err.Number <> 0 Then 'Could not get instance of Excel, so create a new one
Err.Clear
On Error GoTo Error_Handler
Set oExcel = CreateObject("excel.application")
bExcelOpened = False
Else 'Excel was already running
bExcelOpened = True
End If
On Error GoTo Error_Handler
oExcel.ScreenUpdating = False
oExcel.Visible = False 'Keep Excel hidden from the user
oExcel.Application.DisplayAlerts = False
Set oExcelWrkBk = oExcel.Workbooks.Open(sXlsFile)
'Note: you may wish to change the file format constant for another type declared
' above based on your usage/needs in the following line.
oExcelWrkBk.SaveAs Left(sXlsFile, InStrRev(sXlsFile, ".")) & "csv", xlCSVWindows
oExcelWrkBk.Close False
If bExcelOpened = False Then
oExcel.Quit
End If
Error_Handler_Exit:
On Error Resume Next
Set oExcelWrkBk = Nothing
Set oExcel = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ConvertXls2CSV" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function |
Now this could be further improved by extending the error handling further to trap specific errors such as 1004 – file not found, etc… but it definitely illustrates the basic principle in using late binding to utilize Excel to open the file and convert it to *.csv format.
I hope this helps.
Share and Enjoy
MS Access - Excel Automation, MS Access - Outlook Automation, MS Access - Word Automation, MS Access VBA Programming, MS Excel VBA Programming, MS Office, MS Word VBA Programming | No Comments »
