form1.frm

Access数据库转换成Excel样品参考Visual Basic 6源代码

VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H00808080&
   Caption         =   "CONVERSION OF ACCESS EXCEL"
   ClientHeight    =   4830
   ClientLeft      =   6285
   ClientTop       =   3795
   ClientWidth     =   7860
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   ScaleHeight     =   4830
   ScaleWidth      =   7860
   Begin VB.CommandButton Command1 
      BackColor       =   &H00808080&
      Caption         =   "BACK"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   4680
      Style           =   1  'Graphical
      TabIndex        =   4
      Top             =   3000
      Width           =   1215
   End
   Begin VB.CommandButton Command2 
      BackColor       =   &H00808080&
      Caption         =   "CONVERT ACCESS TO EXCEL"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   960
      Style           =   1  'Graphical
      TabIndex        =   1
      Top             =   3000
      Width           =   2895
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackColor       =   &H00808080&
      Caption         =   " "
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   9.75
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   225
      Left            =   2040
      TabIndex        =   3
      Top             =   2400
      Width           =   45
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackColor       =   &H00808080&
      BorderStyle     =   1  'Fixed Single
      Caption         =   "SELECTED ACCESS FILE IS  "
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   12
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   345
      Left            =   2160
      TabIndex        =   2
      Top             =   1440
      Width           =   3255
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackColor       =   &H00808080&
      Caption         =   "CONVERSION OF ACCESS TO EXCEL "
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   18
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   390
      Left            =   600
      TabIndex        =   0
      Top             =   480
      Width           =   6495
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim fld As Field
Dim sname As String
Dim DB As Database
Dim TB As TableDef
Dim e1 As Excel.Application
Dim k As String
Dim wb As Workbook
Dim ws As Worksheet

Dim BG As String
Dim EN As String
Dim STR As String
Dim STR1 As String
Dim COMD As New ADODB.Command
Dim CONECT As New ADODB.Connection
Dim RECORD As New ADODB.Recordset

Private Sub Command1_Click()
CONECT.Close
Unload Me
Form2.Show
End Sub

Private Sub Command2_Click()
Dim ltr As String
Dim str2 As String
Dim STR As String
Dim p As Integer
Dim I As Integer
p = 1
I = 1
Set e1 = CreateObject("excel.application")
Set wb = e1.Workbooks.Add
Set DB = OpenDatabase(STR1)
For Each TB In DB.TableDefs
 If Left(TB.Name, 4) <> "MSys" And Left(TB.Name, 4) <> "USys" Then
  If p <= 3 Then
     Set ws = wb.Sheets(p)
  Else
     Sheets.Add
     Sheets.Move after:=Sheets(Sheets.Count)
     Set ws = wb.ActiveSheet
  End If
  STR1 = TB.Name
  STR = "select * from "
  str2 = STR & STR1
  COMD.CommandText = str2
  Set RECORD = COMD.Execute
  If RECORD.EOF = True And RECORD.BOF = True Then
  MsgBox "SORRY DEAR "
  Else
  If IsNull(RECORD.Fields()) Then
     MsgBox "sorry"
       Else
         I = 1
         While Not RECORD.EOF
           For j = 0 To TB.Fields.Count - 1
              ytr = Null
              If IsNull(RECORD.Fields(j)) Then
              ltr = "null value"
              Else
              ltr = RECORD.Fields(j)
              End If
              ws.Cells(I, j + 1).Value = ltr
              Next j
              RECORD.MoveNext
              I = I + 1
         Wend
     End If
   End If
 p = p + 1
 ws.Name = TB.Name
 End If
 Next
 Unload Me
 e1.Visible = True
 e1.Quit
 End Sub
Private Sub Form_Load()
Dim PTR As String
Dim PTR1 As String
Dim STR As String
Dim str2 As String
STR = " provider=Microsoft.Jet.OLEDB.4.0;Data Source="
Label3.Caption = Form2.Text1.Text
STR1 = Form2.Text1.Text
str2 = STR + STR1
CONECT.Open (str2)
COMD.ActiveConnection = CONECT
End Sub

Private Sub Form_Terminate()
'e1.Quit
End Sub