我的一个失败作品

Private Sub CmdList1_Click()
On Error GoTo Err
Dim pFilePath As String

    With Me.CommonDialog1
        .Filter = "Microsoft Excel 工作表(*.xls)|*.xls"
        .CancelError = True
        .ShowOpen
        pFilePath = CommonDialog1.FileName
    End With

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    Dim xlApp As New Excel.Application, pTable As String
    Set xlApp = CreateObject("Excel.Application")

    xlApp.Application.IgnoreRemoteRequests = False
    xlApp.Visible = False
   
    Set xlBook = xlApp.Workbooks.Open("" & pFilePath & "")
'    For i = 1 To xlApp.Sheets.Count
        pTable = xlApp.Sheets(1).Name
'    Next

    xlApp.Workbooks.Close
    Set xlApp = Nothing

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
LabelWork1.Caption = "Excel工作薄名：" & pTable & "."
Dim strSQL As String
strSQL = "select * from [" & pTable & "$]"
Dim pSetLink As String

pSetLink = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & pFilePath & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
Adodc1.ConnectionString = pSetLink
Adodc1.RecordSource = strSQL
Adodc1.Refresh

Adodc1.Recordset.MoveFirst
pColumns = DataGrid1.Columns.Count

For j = 0 To DataGrid1.Columns.Count - 1
'    xlSheet.Cells(1, j + 1) = DataGrid1.Columns.Item(j).Caption
    ComboName.AddItem DataGrid1.Columns.Item(j).Caption, j
Next j

Err:
    Select Case Err.Number
        Case 32755
        Case Else
            Exit Sub
    End Select
End Sub

Private Sub CmdList2_Click()
On Error GoTo Err
Dim pFilePath As String

    With Me.CommonDialog2
        .Filter = "Microsoft Excel 工作表(*.xls)|*.xls"
        .CancelError = True
        .ShowOpen
        pFilePath = CommonDialog2.FileName
    End With

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    Dim xlApp As New Excel.Application, pTable As String
    Set xlApp = CreateObject("Excel.Application")

    xlApp.Application.IgnoreRemoteRequests = False
    xlApp.Visible = False
   
    Set xlBook = xlApp.Workbooks.Open("" & pFilePath & "")
'    For i = 1 To xlApp.Sheets.Count
        pTable = xlApp.Sheets(1).Name
'    Next

    xlApp.Workbooks.Close
    Set xlApp = Nothing

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
LabelWork2.Caption = "Excel工作薄名：" & pTable & "."
Dim strSQL As String
strSQL = "select * from [" & pTable & "$]"
Dim pSetLink As String

pSetLink = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & pFilePath & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
Adodc2.ConnectionString = pSetLink
Adodc2.RecordSource = strSQL
Adodc2.Refresh
Adodc1.Recordset.MoveFirst

Err:
    Select Case Err.Number
        Case 32755
        Case Else
            Exit Sub
    End Select
End Sub

Private Sub CmdOutput_Click()
On Error GoTo FileErr

Dim pFilePath As String

    With Me.CommonDialog3
        .Filter = "Microsoft Excel 工作表(*.xls)|*.xls"
        .CancelError = True
        .ShowOpen
        pFilePath = CommonDialog3.FileName
    End With

Me.MousePointer = 11                                                                    '变化鼠标，开始执行程序

Dim i As Long, j As Long

Dim xlApp As New Excel.Application
Dim xlBook As New Excel.Workbook
Dim xlSheet As New Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")

xlApp.Application.IgnoreRemoteRequests = False
xlApp.Visible = False                                                                   '使EXCEL不可见

Set xlBook = xlApp.Workbooks.Add
Set xlBook = xlApp.Workbooks.Open("" & pFilePath & "")

Set xlSheet = xlBook.Worksheets(1)
For j = 0 To DataGrid1.Columns.Count - 1                                                '用于向EXCEL中添加字段名
    xlSheet.Cells(1, j + 1) = DataGrid1.Columns.Item(j).Caption
Next j

Call RunValue
'**************************************************************************************************************************************
'If Check1.Value = 1 Then
'    Adodc1.Recordset!电脑单号 = Adodc2.Recordset!电脑单号
'elseif

'    If pCheck1 = True Then
'        Adodc1.Recordset.Fields("电脑单号").Value = Adodc2.Recordset.Fields(电脑单号).Value
'    ElseIf pCheck2 = True Then
'        Adodc1.Recordset.Fields("手写单号").Value = Adodc2.Recordset.Fields(手写单号).Value
'    ElseIf pCheck3 = True Then
'        Adodc1.Recordset.Fields("收货人姓名").Value = Adodc2.Recordset.Fields(收货人姓名).Value
'    ElseIf pCheck4 = True Then
'        Adodc1.Recordset.Fields("运输费").Value = Adodc2.Recordset.Fields(运输费).Value
'    ElseIf pCheck5 = True Then
'        Adodc1.Recordset.Fields("付款方式").Value = Adodc2.Recordset.Fields(付款方式).Value
'    End If

'If (Adodc1.Recordset.Fields("电脑单号").Value = Adodc2.Recordset.Fields(电脑单号).Value) And (Adodc1.Recordset.Fields("手写单号").Value = Adodc2.Recordset.Fields(手写单号).Value) Then

'Dim db As String
'db = (Adodc1.Recordset.Fields("电脑单号").Value = Adodc2.Recordset.Fields(电脑单号).Value) And (Adodc1.Recordset.Fields("手写单号").Value = Adodc2.Recordset.Fields(手写单号).Value)
'If db Then
'
'End If

'Dim pTiaoJian As Boolean
'Select Case pTiaoJian
'    Case pTiaoJian = True
'        Debug.Print "输出语句"
'    Case pTiaoJian = False
'        Debug.Print "输出条件为假。"
'End Select
'ElseIf Adodc1.Recordset.Fields(pID).Value <> Adodc2.Recordset.Fields(pID).Value Then
'''''''''''''''''''''''''''''''''''''''''''''''''
'共计五个CHECK，组合？

'Dim k
'For k = 1 To pColumns
'
'Next k
''''''''''''''''''''''''''''''''''''''''''''''''

Adodc1.Recordset.MoveFirst
Adodc2.Recordset.MoveFirst
Dim dh1, dh2 As String, pID As Integer
pID = ComboName.ListIndex

For i = 0 To Adodc1.Recordset.RecordCount - 1                                           '向EXCEL中添加纵向数据，即计算列
    If Adodc1.Recordset.Fields(pID).Value = Adodc2.Recordset.Fields(pID).Value Then
        i = i - 1
    ElseIf Adodc1.Recordset.Fields(pID).Value <> Adodc2.Recordset.Fields(pID).Value Then
        DataGrid1.Row = i

        For j = 0 To DataGrid1.Columns.Count - 1                                        '此处为循环，向EXCEL中添加横向数据，计算行
            DataGrid1.Col = j
            If IsNull(DataGrid1.Text) = False Then
                xlSheet.Cells(i + 2, j + 1) = Trim(DataGrid1.Text)
            End If
        Next j
    End If
    Adodc1.Recordset.MoveNext
    Adodc2.Recordset.MoveNext
Next i
'**************************************************************************************************************************************
xlApp.Rows("1:1").Select                                                '选中第一行
xlApp.Selection.Font.Bold = True                                        '设为粗体
xlApp.Selection.Font.Size = 9                                           '设置字体大小

'xlApp.Cells.EntireColumn.AutoFit                                        '自动调整列宽
'xlApp.ActiveWindow.SplitRow = 1                                         '拆分第一行
'xlApp.ActiveWindow.SplitColumn = 0                                      '拆分列
'xlApp.ActiveWindow.FreezePanes = True                                   '固定拆分 objExl.ActiveSheet.PageSetup.PrintTitleRows = "$1:$1" '设置打印固定行
'xlApp.ActiveSheet.PageSetup.PrintTitleColumns = ""                      '打印标题 objExl.ActiveSheet.PageSetup.RightFooter = "打印时间: " & Format(Now, "yyyy年mm月dd日 hh:MM:ss")
'xlApp.ActiveWindow.View = xlPageBreakPreview                            '设置显示方式
'xlApp.ActiveWindow.Zoom = 100                                           '设置显示大小
'xlApp.ActiveSheet.Weight = 2

Adodc1.Recordset.MoveLast
Adodc2.Recordset.MoveLast
Me.MousePointer = 1                                                                     '还原鼠标外观

FileErr:
    Select Case Err.Number
        Case 32755
        Case Else
            xlApp.DisplayAlerts = False                                                 '关闭时不提示保存
            xlBook.Save
           
            xlApp.Quit                                                                  '关闭EXCEL
            xlApp.DisplayAlerts = False                                                 '关闭时不提示保存
            xlApp.Workbooks.Close

            Set xlApp = Nothing
            Set xlBook = Nothing
            Set xlSheet = Nothing
            Me.MousePointer = 1
    End Select
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
Call RunCheck
End Sub

Private Sub Form_Load()
On Error Resume Next

Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2
Me.Caption = "数据对比分析器"
CmdOutput.Enabled = False
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call RunCheck
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set Form2 = Nothing
End Sub

Public Sub RunCheck()
If Check1.Value = 1 Or Check2.Value = 1 Or Check3.Value = 1 Or Check4.Value = 1 Or Check5.Value = 1 Then
    CmdOutput.Enabled = True
Else
    CmdOutput.Enabled = False
End If
End Sub

Public Sub RunValue()
Dim pLinkStr

'Select Case pTiaoJian
'    Case pCheck1 = True
'
'    Case pCheck1 = True
''        Debug.Print "输出条件为假。"
'End Select
End Sub