Hi, <br>I need to export data to an excel sheet or some kind of database(acess?) which is obtained via a program I worte in VB. The program reads the value from an instrument and then displays it in a dialog box. I need to then take it from the dialog box, add a time stamp to it and send the value to a database table or spreadsheet. <br>How do I go about this??!!??!<br><br>Thanks for your help.<br>Todd<br>
Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations derfloh on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
Exporting data??
- Thread starter ctodd321
- Start date
Todd -<br><br>Here's a function I wrote to copy from a datacontrol to a spreadsheet. You should be able to easily adapt it to only copying one row of data!<br><br>There's some debug code in there (the block of code surrounded by '#' marked lines). I use a compiler variable called 'dodebug' to switch in/out my debug statements. I set it to various values to enable different levels of debugging (just '1', in this case).<br><br>Chip H.<br><br><br><FONT FACE=monospace>Public Sub DoCopyToExcel(dc As Data)<br> <br> Dim xlApp As Object<br> Dim xlSheet As Object<br> Dim xlRange As Object<br> Dim i As Long<br> Dim j As Long<br> Dim iAnswer As Integer<br> Const EXCEL_OLE_KEY = "Excel.Application"<br> Dim ColumnCount As Long<br> Dim RowCount As Long<br> Dim RangeName As String<br> <br> On Error Resume Next<br> Screen.MousePointer = vbHourglass<br> <br> Set xlApp = GetObject(, EXCEL_OLE_KEY)<br> If Err.Number <> 0 Then<br> 'Excel was not running<br> Err.Clear<br> On Error Resume Next<br> Set xlApp = CreateObject(EXCEL_OLE_KEY)<br> If Err.Number <> 0 Then<br> Set xlApp = Nothing<br> Screen.MousePointer = vbDefault<br> MsgBox "Unable to start a copy of Excel.", vbOKOnly, "Error"<br> Exit Sub '<-------<br> End If<br> End If<br> Err.Clear<br><br> On Error GoTo DoCopyToExcel_Err<br> <br> ' Hide excel while performing stuff below.<br> xlApp.Visible = False<br> xlApp.DisplayAlerts = False<br> xlApp.workbooks.Add<br> xlApp.workbooks(1).Activate<br> Set xlSheet = xlApp.ActiveSheet<br> dc.Recordset.MoveFirst<br> ColumnCount = dc.Recordset.Fields.Count<br> RowCount = dc.Recordset.RecordCount<br> <br> For i = 1 To RowCount + 1<br> For j = 1 To ColumnCount<br> #If dodebug > 1 Then<br> MsgBox "Before setting cell(" & CStr(i) & "," & CStr(j) & "
to value: " & dc.Recordset.Fields(j - 1)<br> #End If<br><br> If i = 1 Then<br> 'show column headings<br> Set xlRange = xlSheet.Cells(i, j)<br> xlRange.Value = dc.Recordset.Fields(j - 1).Name<br> <br> Else<br> Set xlRange = xlSheet.Cells(i, j)<br> xlRange.Value = CStr(dc.Recordset.Fields(j - 1))<br> <br> End If<br> <br> Set xlRange = Nothing<br> Next j<br> <br> If i > 1 Then<br> dc.Recordset.MoveNext<br> <br> ' Give user a chance to bail out<br> If i Mod 200 = 0 Then<br> iAnswer = MsgBox("200 rows done. Continue?", vbYesNo, "Confirm"<br> If iAnswer = vbNo Then<br> Exit For '<=======<br> End If<br> End If<br> End If<br> Next i<br> <br> RangeName = NumberToExcelColumn(1) & ":" & NumberToExcelColumn(ColumnCount)<br> Set xlRange = xlSheet.Columns(RangeName)<br> xlRange.AutoFit<br> <br> xlApp.Visible = True<br> <br> Set xlRange = Nothing<br> Set xlSheet = Nothing<br> Set xlApp = Nothing<br> Screen.MousePointer = vbDefault<br> Exit Sub '<-------<br> <br>DoCopyToExcel_Err:<br> Set xlApp = Nothing<br> Screen.MousePointer = vbDefault<br> Exit Sub '<-------<br> <br>End Sub<br><br>Private Function NumberToExcelColumn(lColNum As Long) As String<br> <br> Dim RVal As String<br><br> If lColNum <= 26 Then<br> RVal = Chr$(lColNum + Asc("A" - 1)<br> Else<br> RVal = Chr$((lColNum Mod 26) + Asc("A" - 1)<br> RVal = Chr$((lColNum \ 26) + Asc("A" - 1) & RVal<br> End If<br> <br> NumberToExcelColumn = RVal<br>End Function<br></font><br><br>
to value: " & dc.Recordset.Fields(j - 1)<br> #End If<br><br> If i = 1 Then<br> 'show column headings<br> Set xlRange = xlSheet.Cells(i, j)<br> xlRange.Value = dc.Recordset.Fields(j - 1).Name<br> <br> Else<br> Set xlRange = xlSheet.Cells(i, j)<br> xlRange.Value = CStr(dc.Recordset.Fields(j - 1))<br> <br> End If<br> <br> Set xlRange = Nothing<br> Next j<br> <br> If i > 1 Then<br> dc.Recordset.MoveNext<br> <br> ' Give user a chance to bail out<br> If i Mod 200 = 0 Then<br> iAnswer = MsgBox("200 rows done. Continue?", vbYesNo, "Confirm"<br> If iAnswer = vbNo Then<br> Exit For '<=======<br> End If<br> End If<br> End If<br> Next i<br> <br> RangeName = NumberToExcelColumn(1) & ":" & NumberToExcelColumn(ColumnCount)<br> Set xlRange = xlSheet.Columns(RangeName)<br> xlRange.AutoFit<br> <br> xlApp.Visible = True<br> <br> Set xlRange = Nothing<br> Set xlSheet = Nothing<br> Set xlApp = Nothing<br> Screen.MousePointer = vbDefault<br> Exit Sub '<-------<br> <br>DoCopyToExcel_Err:<br> Set xlApp = Nothing<br> Screen.MousePointer = vbDefault<br> Exit Sub '<-------<br> <br>End Sub<br><br>Private Function NumberToExcelColumn(lColNum As Long) As String<br> <br> Dim RVal As String<br><br> If lColNum <= 26 Then<br> RVal = Chr$(lColNum + Asc("A" - 1)<br> Else<br> RVal = Chr$((lColNum Mod 26) + Asc("A" - 1)<br> RVal = Chr$((lColNum \ 26) + Asc("A" - 1) & RVal<br> End If<br> <br> NumberToExcelColumn = RVal<br>End Function<br></font><br><br> - Thread starter
- #3
Hey, <br>Thanks very much. I'm having trouble with a type mismatch error.<br>Getting the value to be recognized by your code?<br>I think its troube with the: dc as Data - How to convert something<br>from a textbox, i.e: 'variable.name' to the proper form (as data?)<br><br>Thanks, <br>Todd
Todd,<br><br>The 'As Data' means that he's passing the name of the Data Control to his function - so that he can read records from it (it's bound to some database or other) and put them into the Excel spreadsheet.<br><br>Have a look at these lines I've cut (from what looks like an excellent routine by the way):<br><br>Set xlApp = CreateObject(EXCEL_OLE_KEY)<br>xlApp.workbooks.Add<br>xlApp.workbooks(1).Activate<br>Set xlSheet = xlApp.ActiveSheet<br>Set xlRange = xlSheet.Cells(i, j)<br>xlRange.Value = dc.Recordset.Fields(j - 1).Name<br><br>These lines are the core of it and are very powerful, they:<br><br>open excel,<br>make a new workbook,<br>activate a worksheet,<br>set a range,<br>update those cells<br><br>the "dc.Recordset.Fields(j - 1).Name" bit is a field in a table - it's some data, the data that is being put in the range.<br><br>Have a play with a small VB app containing code like this - when you understand what goes on you should use all Chip's error checking code...<br><br>Mike <p>Mike Lacey<br><a href=mailto:Mike_Lacey@Cargill.Com>Mike_Lacey@Cargill.Com</a><br><a href= Cargill's Corporate Web Site</a><br>
- Status
Similar threads
