关于VB6.0导出SQL数据库中数据到EXCEL代码问题

关于VB6.0导出SQL数据库中数据到EXCEL代码问题,第1张

请问:

你的 Private Sub exporttoexcel(rsdata As ADODBRecordset, filenamesaveas As String)的声明是在Module里吗?如果是,将Private 改为Public,然后试试

注:Form中过程或函数等,无法对Module中以Private声明的过程或函数等调用

希望以上对你有所帮助。

可以两种方式:

1、用VB *** 作EXCEL类,然后将SQLSERVER的数据查询到dataset中,循环dataset中的数据到EXCEL;

2、将EXCEL当作数据源,用MicrosoftJetOLEDB40来连接,然后直接将SQLSERVER的数据写入EXCEL的SHEET1表中。

用下面这段代码,根据自己实际修改一下就好

Private Sub Command1_Click()

Dim i As Integer

Dim j As Integer

Dim xlApp As ExcelApplication

Dim xlBook As ExcelWorkbook

Dim xlSheet As ExcelWorksheet

Set xlApp = CreateObject("ExcelApplication")

xlAppVisible = True

Set xlBook = xlAppWorkbooksAdd

Set xlSheet = xlBookWorksheets(1)

If Adodc1RecordsetRecordCount > 0 Then

xlAppVisible = True

xlSheetRange(xlSheetCells(1, 1), xlSheetCells(1, 9))Merge

xlSheetRange(xlSheetCells(1, 1), xlSheetCells(1, 9)) = "未发料统计表"

xlSheetRange(xlSheetCells(1, 1), xlSheetCells(1, 9))HorizontalAlignment = xlCenter

xlSheetRange(xlSheetCells(1, 1), xlSheetCells(1, 9))VerticalAlignment = xlCenter

'xlSheetCells(1, 9) = "未发料统计表"

For i = 0 To TDBGrid1ColumnsCount - 1

xlSheetCells(2, i + 1) = TDBGrid1Columns(i)Caption

Next i

Adodc1RecordsetMoveFirst

Do Until Adodc1RecordsetEOF

i = Adodc1RecordsetAbsolutePosition

For j = 0 To TDBGrid1ColumnsCount - 1

xlSheetCells(i + 2, j + 1) = TDBGrid1Columns(j)

Next j

Adodc1RecordsetMoveNext

Loop

xlSheetRange(xlSheetCells(1, 1), xlSheetCells(i + 2, j))BordersLineStyle = xlContinuous

End If

End Sub

Private Sub Command1_Click()

    Dim xlapp As Variant

    Dim xlBook As Variant

    Dim xlSheet As Variant

    Dim sum As Long

    Set xlapp = CreateObject("excelapplication")

    Set xlBook = xlappWorkbooksOpen(AppPath & "\data\报表xlt") '打开EXCEL模板

    'Set xlBook = xlappWorkbooksAdd

    Set xlSheet = xlBookworksheets(1)

    xlappVisible = True

    Adodc1ConnectionString = cnConnectionString

    Adodc1RecordSource = "select  from [Sheet1] where 试验号='" & shiyanH & "'"

    Adodc1Refresh

    If Adodc1RecordsetRecordCount > 0 Then

    Adodc1RecordsetMoveFirst

    xlSheetCells(sum + 1, 2) = shiyanH

    For sum = 0 To Adodc1RecordsetRecordCount - 1

        xlSheetCells(sum + 3, 1) = Adodc1Recordset(1)

        For j = 2 To 21

            If Adodc1Recordset(j) <> "" Then

                If Adodc1Recordset(j) = "" Then

                    xlSheetCells(sum + 3, j) = (Adodc1Recordset(j))

                Else

                    xlSheetCells(sum + 3, j) = Val(Adodc1Recordset(j))

                End If

            End If

        Next

        Adodc1RecordsetMoveNext

    Next sum

    End If

End Sub

Sub Main()

    cnConnectionString = "Provider=MicrosoftJetOLEDB40;Data Source=" & AppPath & "\data\tsdbmdb;Persist Security Info=False"

    frmStartShow

End Sub

以上是读取Access数据表,导入到Excel的代码。

'Visual Basic调用Excel有点难,但是Excel有一种CSV逗号分隔格式,可以借助FileSystemObject来创建。

'先像你那张一样画好窗体,四个文本框分别设为txtName、txtChinese、txtMaths、txtZhengZhi,按钮设为CmdOut。

'代码如下:

Public strPathName

Private Sub Form_Load()

InputPath:

strPathName = InputBox("请输入表格保存位置","请输入")

If Right(strPathName,3) <> "csv" Then strPathname = strPathName & "csv"

Set fso = CreateObject("ScriptingFileSystemObject")

If fsoFileExists(strPathName) Then

 A = MsgBox("文件已存在,是否覆盖",vbYesNo,"文件已存在")

 

 If A = vbYes Then

  Kill(strPathName)

 Else

  GoTo InputPath

 End If

End If

Set txtfile = fsoCreateTextFile(strPathName,True)

End Sub

Private Sub Command1_Click()

Set fso = CreateObject("ScriptingFileSystemObject")

IntFreeFile = FreeFile

Open strPathName For Input As IntFreeFile

strContent = StrConv(InputB(LOF(IntFreeFile), IntFreeFile), vbUnicode)

Close #IntFreeFile

If strContent = "" Then

Kill(strPathName)

Set txtfile = fsoCreateTextFile(strPathName,True)

txtfileWrite("姓名,语文,数学,政治" & vbCrlf & txtNametext & "," & txtChinesetext & "," & txtMathstext & "," & txtZhengZhitext)

txtfileClose

Else

Kill(strPathName)

Set txtfile = fsoCreateTextFile(strPathName,True)

txtfileWrite(strContent & vbCrlf & txtNametext & "," & txtChinesetext & "," & txtMathstext & "," & txtZhengZhitext)

txtfileClose

End If

End Sub

'经测试代码可以使用,没有Bug

'生成的Excel:

以上就是关于关于VB6.0导出SQL数据库中数据到EXCEL代码问题全部的内容,包括:关于VB6.0导出SQL数据库中数据到EXCEL代码问题、vb导出sqlserver数据库中表的数据到excel中,在程序中点击Command按钮,就导出了 !、VB中把SQL数据库的数据输出到Excel等相关内容解答,如果想了解更多相关内容,可以关注我们,你们的支持是我们更新的动力!

欢迎分享,转载请注明来源:内存溢出

原文地址: https://outofmemory.cn/sjk/10113096.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-05
下一篇 2023-05-05

发表评论

登录后才能评论

评论列表(0条)

保存