'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