0% found this document useful (0 votes)
101 views8 pages

VB6 Excel Integration Example Code

This code provides examples of reading from and writing to both text files and Excel files from Visual Basic. It uses the Microsoft Excel and ADO object models to open an Excel workbook, read/write cell values, and save the file. The text file export loops through a recordset, writes field values to a comma-delimited file, and saves it. It also demonstrates adding records to a "sent" log after export.
Copyright
© Attribution Non-Commercial (BY-NC)
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOC, PDF, TXT or read online on Scribd
0% found this document useful (0 votes)
101 views8 pages

VB6 Excel Integration Example Code

This code provides examples of reading from and writing to both text files and Excel files from Visual Basic. It uses the Microsoft Excel and ADO object models to open an Excel workbook, read/write cell values, and save the file. The text file export loops through a recordset, writes field values to a comma-delimited file, and saves it. It also demonstrates adding records to a "sent" log after export.
Copyright
© Attribution Non-Commercial (BY-NC)
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as DOC, PDF, TXT or read online on Scribd

'do declare these variables you need to add a reference 'to the microsoft excel 'xx' object library.

'you need two text boxes and two command buttons 'on the form, an excel file in c:\[Link] Dim xl As New [Link] Dim xlsheet As [Link] Dim xlwbook As [Link] Private Sub Command1_Click() 'the benifit of placing numbers in (row, col) is that you 'can loop through different directions if required. I could 'have used column names like "A1" 'etc. [Link] = [Link](2, 1) ' row 2 col 1 [Link] = [Link](2, 2) ' row 2 col 2 'don't forget to do this or you'll not be able to open '[Link] again, untill you restart you pc. [Link] False, "c:\[Link]" [Link] End Sub Private Sub Command2_Click() [Link](2, 1) = [Link] [Link](2, 2) = [Link] [Link] 'don't forget to do this or you'll not be able to open '[Link] again, untill you restart you pc. [Link] False, "c:\[Link]" [Link] End Sub Private Sub Form_Load() Set xlwbook = [Link]("c:\[Link]") Set xlsheet = [Link](1) End Sub Private Sub Form_Unload(Cancel As Integer) Set xlwbook = Nothing Set xl = Nothing End Sub

Here is code to write to a text file and an excel file. As far as the reading from an excel file I am at a loss. You will need to add the Microsoft Common Dialog Control 6.0 (SP3) reference to your project.

As far as using the text file, I do have problems when users enter a comma in a field, it doesn't use text delimiters. It makes it difficult to parse the data when I receive it. HTH, Tricia Call txt(rstSendFile) Call excel(rstSentFile)

(SEND MODULE) Option Explicit Public rstSendFile As [Link] Public objExcel As Object Public objTemp As Object Public rstSendInfo As [Link] Public Function txt(rstSendFile As [Link]) As Boolean Dim iTotalRecords As Integer Dim sFileToExport As String Dim iFileNum As Integer Dim msg As String Dim iIndx As Integer Dim iNumberOfFields As Integer [Link] = vbDefault On Error Resume Next CreateSendFile If [Link] = 0 Then Exit Function With frmMain.CD1 .CancelError = True .FileName = "Export" & gsCustomerNumber & ".txt" .InitDir = [Link] .DialogTitle = "Save Text File" .Filter = "Export Files (*.txt)|*.txt" .DefaultExt = "TXT" .Flags = cdlOFNOverwritePrompt Or cdlOFNCreatePrompt .ShowSave End With

'-------------------------------'-- User cancels the operation -'-------------------------------If [Link] = cdlCancel Then 'operation canceled [Link] = vbDefault msg = "The export operation was canceled." & vbCrLf iIndx = MsgBox(msg, vbOKOnly + vbInformation, "Text Export File") txt = False Exit Function Else On Error GoTo ErrorHandler End If '--------------------------------------'-- Let's save the data now. -'-- Get the name of the file to save. -'--------------------------------------[Link] = vbHourglass iTotalRecords = 0 sFileToExport = [Link] iFileNum = FreeFile() Open sFileToExport For Output As #iFileNum ' Open file for output. '------------------------'-- Stream out the data -'------------------------iNumberOfFields = [Link] - 1 [Link] Do Until [Link] iTotalRecords = iTotalRecords + 1 For iIndx = 0 To iNumberOfFields If (IsNull([Link](iIndx))) Then Print #iFileNum, ","; 'simply a comma delimited string Else If iIndx = iNumberOfFields Then Print #iFileNum, Trim$(CStr([Link](iIndx))); Else Print #iFileNum, Trim$(CStr([Link](iIndx))); ","; End If End If Next Print #iFileNum,

[Link] DoEvents Loop '---------------Close #iFileNum [Link] = vbDefault msg = "Export File " & sFileToExport & vbCrLf msg = msg & "successfully created." & vbCrLf msg = msg & iTotalRecords & " records written to disk." & vbCrLf iIndx = MsgBox(msg, vbOKOnly + vbInformation, "Comma Delimited File") txt = True Dim iResponse As Integer If MsgBox("Do you want to record these records as sent?", _ vbYesNoCancel, gsDialogTitle) = vbYes Then With rstSendInfo If .EOF Then .MoveFirst !FileSentDate = Now() .Update Else !FileSentDate = Now() .Update End If End With End If Exit Function ErrorHandler: DisplayErrorMessage txt = False End Function Public Sub CreateSendFile() Set rstSendFile = New [Link] Set rstSendInfo = New [Link] [Link] = adUseClient [Link] = adUseClient [Link] "SELECT * FROM qrySendInfo", gcnDue, adOpenForwardOnly, adLockOptimistic, adCmdText

[Link] "select * FROM SendInfo", gcnDue, adOpenForwardOnly, adLockOptimistic, adCmdText If [Link] = 0 Then MsgBox "There are no records to export.", vbOKOnly, gsDialogTitle Else MsgBox [Link] & " records will be exported.", vbOKOnly, gsDialogTitle End If End Sub Public Sub excel(rstSendFile As [Link]) Dim Dim Dim Dim Dim Dim Dim Dim iIndx As Integer iRowIndex As Integer iColIndex As Integer iRecordCount As Integer iFieldCount As Integer sMessage As String avRows As Variant excelVersion As Integer

On Error GoTo ErrHandler CreateSendFile If [Link] = 0 Then Exit Sub '-- Read all of the records into our array avRows = [Link]() '-- Determine how many fields and records iRecordCount = UBound(avRows, 2) + 1 iFieldCount = UBound(avRows, 1) + 1 '-- Create reference variable for the spreadsheet Set objExcel = CreateObject("[Link]") [Link] = True [Link] '-- We need this line to insure Excel remains visible if we switch Set objTemp = objExcel excelVersion = Val([Link]) If (excelVersion >= 8) Then Set objExcel = [Link]

End If '-- Place the names of the fields as column headers -iRowIndex = 1 iColIndex = 1 For iColIndex = 1 To iFieldCount With [Link](iRowIndex, iColIndex) .Value = [Link](iColIndex - 1).Name With .Font .Name = "Arial" .Bold = True .Size = 9 End With End With Next '-- memory management -[Link] Set rstSendFile = Nothing '-- Just add data -With objExcel For iRowIndex = 2 To iRecordCount + 1 For iColIndex = 1 To iFieldCount .Cells(iRowIndex, iColIndex).Value = avRows(iColIndex - 1, iRowIndex - 2) Next Next End With [Link](1, 1).[Link] Dim iResponse As Integer If MsgBox("Do you want to record these records as sent?", _ vbYesNoCancel, gsDialogTitle) = vbYes Then With rstSendInfo If .EOF Then .MoveFirst !FileSentDate = Now() .Update Else !FileSentDate = Now() .Update End If

End With End If Exit Sub Exit Sub ErrHandler: If [Link] = 429 Then MsgBox "You cannot use this feature unless you have Microsoft Excel loaded." Exit Sub Else DisplayErrorMessage Exit Sub End If End Sub dim oconn as [Link] dim ors as [Link] ' ' this assumes that the first row contains headers ' Set oConn = New [Link] [Link] "Provider=[Link].4.0;" & "Data Source=" & sxlsfilename & ";" & "Extended Properties=""Excel 8.0;HDR=YES;""" ' ' the table name is the worksheet name ' sTableName = "[sheet1$]" sTableName = "select * from " & sTableName ' 'Get the recordset ' Set oRS = New [Link] [Link] sTableName, oConn, adOpenStatic, adLockOptimistic nCols = [Link] Add a reference to Microsft excel object library: Option Explicit Private Sub Command1_Click() Dim xlApp As [Link] Dim wb As Workbook Dim ws As Worksheet Dim var As Variant

Set xlApp = New [Link] Set wb = [Link]("PATH TO YOUR EXCEL FILE") Set ws = [Link]("Sheet1") 'Specify your worksheet name var = [Link]("A1").Value 'or var = [Link](1, 1).Value [Link] [Link] Set ws = Nothing Set wb = Nothing Set xlApp = Nothing End Sub

You might also like