frmmain.frm

xls_xml.rar

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frmMain 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "保监会对接 XML 文档转换"
   ClientHeight    =   5970
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8835
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5970
   ScaleWidth      =   8835
   StartUpPosition =   2  'CenterScreen
   Begin VB.TextBox Text2 
      Height          =   285
      Left            =   1200
      TabIndex        =   20
      Top             =   2835
      Width           =   3255
   End
   Begin MSComCtl2.DTPicker DTPicker1 
      Height          =   375
      Left            =   1200
      TabIndex        =   17
      Top             =   2100
      Width           =   1575
      _ExtentX        =   2778
      _ExtentY        =   661
      _Version        =   393216
      CustomFormat    =   "yyyyMM"
      Format          =   19922947
      CurrentDate     =   36526
   End
   Begin MSComctlLib.StatusBar StatusBar1 
      Align           =   2  'Align Bottom
      Height          =   375
      Left            =   0
      TabIndex        =   16
      Top             =   5595
      Width           =   8835
      _ExtentX        =   15584
      _ExtentY        =   661
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   1
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
            Object.Width           =   13123
            MinWidth        =   13123
         EndProperty
      EndProperty
   End
   Begin VB.Frame Frame3 
      Caption         =   "选择区域"
      Height          =   615
      Left            =   4440
      TabIndex        =   13
      Top             =   1320
      Width           =   3495
      Begin VB.OptionButton Option6 
         Caption         =   "000055000000"
         Height          =   255
         Left            =   1800
         TabIndex        =   15
         Top             =   240
         Width           =   1575
      End
      Begin VB.OptionButton Option5 
         Caption         =   "000055310000"
         Height          =   255
         Left            =   240
         TabIndex        =   14
         Top             =   240
         Width           =   1455
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "选择类型"
      Height          =   615
      Left            =   360
      TabIndex        =   8
      Top             =   1320
      Width           =   3855
      Begin VB.OptionButton Option4 
         Caption         =   "年报"
         Enabled         =   0   'False
         Height          =   255
         Left            =   2880
         TabIndex        =   12
         Top             =   240
         Width           =   855
      End
      Begin VB.OptionButton Option3 
         Caption         =   "季报"
         Height          =   255
         Left            =   2040
         TabIndex        =   11
         Top             =   240
         Width           =   1455
      End
      Begin VB.OptionButton Option2 
         Caption         =   "月报"
         Height          =   255
         Left            =   1200
         TabIndex        =   10
         Top             =   240
         Width           =   1455
      End
      Begin VB.OptionButton Option1 
         Caption         =   "快报"
         Height          =   255
         Left            =   360
         TabIndex        =   9
         Top             =   240
         Width           =   1455
      End
   End
   Begin VB.CommandButton Command2 
      Caption         =   "退出系统"
      Height          =   425
      Left            =   6720
      TabIndex        =   7
      Top             =   4920
      Width           =   1815
   End
   Begin VB.PictureBox Picture1 
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      FillStyle       =   0  'Solid
      Height          =   480
      Left            =   5400
      Picture         =   "frmMain.frx":28FC2
      ScaleHeight     =   480
      ScaleWidth      =   480
      TabIndex        =   6
      ToolTipText     =   "双击显示快照"
      Top             =   720
      Width           =   480
   End
   Begin VB.ComboBox Combo1 
      BackColor       =   &H00C0FFFF&
      Height          =   315
      Left            =   2280
      TabIndex        =   5
      Top             =   840
      Width           =   3015
   End
   Begin VB.TextBox Text1 
      BackColor       =   &H00C0FFFF&
      Height          =   325
      Left            =   2280
      Locked          =   -1  'True
      TabIndex        =   3
      Top             =   360
      Width           =   6255
   End
   Begin VB.CommandButton Command3 
      Caption         =   "选择 MDB 文件 ..."
      Height          =   325
      Left            =   360
      TabIndex        =   2
      Top             =   360
      Width           =   1815
   End
   Begin VB.Frame Frame1 
      Height          =   135
      Left            =   120
      TabIndex        =   1
      Top             =   2520
      Width           =   8415
   End
   Begin VB.CommandButton Command1 
      Caption         =   "转换 XML 文件"
      Enabled         =   0   'False
      Height          =   425
      Left            =   4800
      TabIndex        =   0
      Top             =   4920
      Width           =   1815
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   0
      Top             =   0
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "生成文件名"
      Height          =   195
      Left            =   120
      TabIndex        =   19
      Top             =   2880
      Width           =   900
   End
   Begin VB.Label Label3 
      Caption         =   "选择月份"
      Height          =   255
      Left            =   360
      TabIndex        =   18
      Top             =   2160
      Width           =   1455
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "选择表:"
      Height          =   195
      Left            =   1440
      TabIndex        =   4
      Top             =   900
      Width           =   585
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'注：我直接使用 xls文件有问题，通过ado读取时，发现某些内容读不出来，所以你要注意
'为了安全我使用ACCESS数据库，操作只需要将excel 文件内容拷贝到ACCESS中






Private Sub Combo1_Click()
    SelectTableName = Combo1.Text
    BindRs (SelectTableName)
    If ShowColumns = True Then Me.Command1.Enabled = True
End Sub



Private Sub Command1_Click()
    If Me.Option1.Value = False And Me.Option2.Value = False And Me.Option3.Value = False And Me.Option4.Value = False Then
        MsgBox ("您没有选择类型")
        Exit Sub
    End If
    If Me.Option5.Value = False And Me.Option6.Value = False Then
        MsgBox ("您没有选择区域")
        Exit Sub
    End If
    
    If Format(Me.DTPicker1.Value, "yyyyMMDD") = "20000101" Then
        MsgBox ("您没有选择月份")
        Exit Sub
    End If
    Call Conversion(Me.Text1.Text, Me.CommonDialog1.FileTitle)
    Me.DTPicker1.Value = "2000-01-01"
End Sub

Private Sub Command2_Click()
    End
End Sub

'Private Sub Command2_Click()
'此一模块共有四个参数:
'1、sSheetName：要导出资料的文件名称 (Sheet name)，例如 Sheet1
'2、sExcelPath：要导出资料的 Excel 档案路径名称 (Workbook path)，例如 C:\book1.xls
'3、sAccessTable：要导入的 Access Table 名称，例如 TestTable
'4、sAccessDBPath：要导入的 Access 档案路径名称，例如 C:\Test.mdb
'
'在声明中加入以下:'
'Private Sub ExportExcelSheetToAccess(sSheetName As String, sExcelPath As String, sAccessTable As String, sAccessDBPath As String)
'Dim db As Database
'Dim rs As Recordset
'Set db = OpenDatabase(sExcelPath, True, False, "Excel 5.0")
'Call db.Execute("Select * into [;database=" & sAccessDBPath & "]." & sAccessTable & " FROM [" & sSheetName & "$]")
'MsgBox "Table exported successfully.", vbInformation, "Yams"
'End Sub
'使用范例如下：將 C:\book1.xls 中的 Sheet1 导入 C:\Test.mdb 成为 TestTable'
'ExportExcelSheetToAccess "Sheet1", "C:\book1.xls", "TestTable", "C:\Test.mdb"
'End Sub


Private Sub Command3_Click()

    '选择需要转换的EXCEL数据文件
    '重要:EXCEL中的每一列必须将全部的错误格式转换为数值，否则系统将不能识别
     Dim i As Integer
     Dim Y As Integer
     Dim Z As Integer
     Dim FileNames$()
     
     CommonDialog1.filename = ""
     CommonDialog1.Filter = "mdb Files|*.mdb"
     'CommonDialog1.Flags = cdlOFNAllowMultiselect + cdlOFNExplorer
     CommonDialog1.Action = 1
     CommonDialog1.filename = CommonDialog1.filename & Chr(0)
     
     Z = 1
     For i = 1 To Len(CommonDialog1.filename)
        i = InStr(Z, CommonDialog1.filename, Chr(0))
        If i = 0 Then Exit For
        ReDim Preserve FileNames(Y)
        FileNames(Y) = Mid(CommonDialog1.filename, Z, i - Z)
        Z = i + 1
        Y = Y + 1
     Next
     
     If Y = 1 Then
        Text1.Text = FileNames(0)
     Else
        Text2.Text = ""
        For i = 0 To Y - 1
        If i = 0 Then
            Text1.Text = FileNames(i)
        Else
            'Text2.Text = Text2.Text & UCase(FileNames(I)) Chr$ (13) & Chr$(10)
        End If
        Next
     End If
    
    If Text1.Text <> "" Then
        
        Me.Combo1.Clear
        
        Call InitializeDataBase(Me.Text1.Text, Me.CommonDialog1.FileTitle)
        
        
        Dim adoConnectionX As New ADODB.Connection
        'adoConnectionX.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Data Source=yuer;DataBase=NorthwindCS"
        'adoConnectionX.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:\DRptPlus\DRptPlus\Data\NWind2K.mdb;Persist Security Info=False"
         adoConnectionX.ConnectionString = connString
         adoConnectionX.Open
          
          
        Dim adoxCatalogX As New ADOX.Catalog
        Set adoxCatalogX.ActiveConnection = adoConnectionX
         
        Dim boolI As Boolean
        Dim TestTableName As String
        Dim adoxTableX As ADOX.Table
        
        For Each adoxTableX In adoxCatalogX.Tables
            If Left(adoxTableX.Name, 4) <> "MSys" Then
            
                If boolI = False Then Combo1.Text = adoxTableX.Name
                boolI = True
                Me.Combo1.AddItem adoxTableX.Name
            End If
        Next
        SelectTableName = Combo1.Text
        Call BindRs(Combo1.Text)
        
        

         Me.Command1.Enabled = True
    End If
End Sub


Private Sub Dir1_Click()
StatusBar1.Panels(1).Text = Dir1.Path
End Sub


Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub