VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form frmExport 
   Caption         =   "導出記錄"
   ClientHeight    =   3090
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5850
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3090
   ScaleWidth      =   5850
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdPath 
      Caption         =   "..."
      Height          =   375
      Left            =   4440
      TabIndex        =   4
      Top             =   840
      Width           =   495
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取  消"
      Height          =   495
      Left            =   3480
      TabIndex        =   3
      Top             =   1920
      Width           =   1335
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "導  出"
      Height          =   495
      Left            =   1200
      TabIndex        =   2
      Top             =   1920
      Width           =   1335
   End
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   4800
      Top             =   120
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.TextBox textFilePath 
      BeginProperty Font 
         Name            =   "楷體_GB2312"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2280
      TabIndex        =   1
      Top             =   840
      Width           =   1935
   End
   Begin VB.Label Label2 
      Caption         =   "保存為"
      BeginProperty Font 
         Name            =   "楷體_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1200
      TabIndex        =   0
      Top             =   840
      Width           =   855
   End
End
Attribute VB_Name = "frmExport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public strFilepath As String

Private Sub cmdCancel_Click()
    Unload Me
    Exit Sub
End Sub

Private Sub cmdOK_Click()
    Dim i As Integer
    Dim rsobj As New ADODB.Recordset
    Dim sql As String
    Dim firstday As String
    Dim days As Integer
    Dim lastday As String
    Dim oExcel As Object
    Dim oBook As Object
    Dim oSheet As Object
    
On Error GoTo Command1_Click_Error
    If Me.textFilePath = "" Then                                               '判斷輸入
        MsgBox "請選擇文件保存位置！", vbOKOnly + vbExclamation, "提示！"
    Else
        sql = "select * from Personal order by ID"
        Set rsobj = getRS(sql)
        If rsobj.EOF = False Then                                              '判斷是否有統計記錄
        
            Set oExcel = CreateObject("Excel.Application")
            Set oBook = oExcel.Workbooks.Add
            Set oSheet = oBook.Worksheets(1)
            Set oSheet = oExcel.Application.Workbooks(1).Worksheets("Sheet1")
                 
            oSheet.Range("A1:L1").Select                                       '設置單元格
            With oExcel.Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
                .MergeCells = False
            End With
            
            oExcel.Selection.Merge                                            '設置標題
            oSheet.Range("A1:L1").Select
            oExcel.ActiveCell.FormulaR1C1 = "客戶信息列表"
            
            With oExcel.ActiveCell.Characters(Start:=1, Length:=26).Font
                .Name = "宋體"
                .FontStyle = "加粗"
                .Size = 18
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = xlAutomatic
            End With
            
            Set oSheet = oExcel.Application.Workbooks(1).Worksheets("Sheet1") '設置表格
            
                oSheet.Cells(2, 1).Value = "編號"
                oSheet.Cells(2, 2).Value = "姓名"
                oSheet.Cells(2, 3).Value = "性別"
                oSheet.Cells(2, 4).Value = "年齡"
                oSheet.Cells(2, 5).Value = "生日"
                oSheet.Cells(2, 6).Value = "公司"
                oSheet.Cells(2, 7).Value = "職務"
                oSheet.Cells(2, 8).Value = "住址"
                oSheet.Cells(2, 9).Value = "郵編"
                oSheet.Cells(2, 10).Value = "電話"
                oSheet.Cells(2, 11).Value = "手機"
                oSheet.Cells(2, 12).Value = "傳真"
                oSheet.Cells(2, 13).Value = "Email"
                
                oSheet.Columns("A:A").ColumnWidth = 8
                oSheet.Columns("B:B").ColumnWidth = 6
                oSheet.Columns("C:C").ColumnWidth = 2
                oSheet.Columns("D:D").ColumnWidth = 2
                oSheet.Columns("E:E").ColumnWidth = 8
                oSheet.Columns("F:F").ColumnWidth = 4
                oSheet.Columns("G:G").ColumnWidth = 4
                oSheet.Columns("H:H").ColumnWidth = 4
                oSheet.Columns("I:I").ColumnWidth = 6
                oSheet.Columns("J:J").ColumnWidth = 6
                oSheet.Columns("K:K").ColumnWidth = 4
                oSheet.Columns("L:L").ColumnWidth = 6
                oSheet.Columns("M:M").ColumnWidth = 6
                
                rsobj.MoveFirst
                For i = 3 To rsobj.RecordCount + 2
                    oSheet.Cells(i, 1).Value = rsobj(1)
                    oSheet.Cells(i, 2).Value = rsobj(2)
                    oSheet.Cells(i, 3).Value = rsobj(3)
                    oSheet.Cells(i, 4).Value = rsobj(4)
                    oSheet.Cells(i, 5).Value = Format(rsobj(5), "mm-dd")
                    oSheet.Cells(i, 6).Value = rsobj(6)
                    oSheet.Cells(i, 7).Value = rsobj(7)
                    oSheet.Cells(i, 8).Value = rsobj(8)
                    oSheet.Cells(i, 9).Value = rsobj(9)
                    oSheet.Cells(i, 10).Value = rsobj(10)
                    oSheet.Cells(i, 11).Value = rsobj(11)
                    oSheet.Cells(i, 12).Value = rsobj(12)
                    oSheet.Cells(i, 13).Value = rsobj(13)
                    rsobj.MoveNext
                Next i
                
            With oSheet                                                         '設置邊框
                .Range(.Cells(1, 1), .Cells(rsobj.RecordCount + 2, 13)).Borders.LineStyle = xlContinuous
            End With
            
            oBook.SaveAs strFilepath                                            '保存文件
            
            If MsgBox("是否轉到導出的Excel文件？", vbOKCancel) = vbOK Then
            Unload Me
            oExcel.Visible = True
            Else
            MsgBox "已經成功導出記錄！", vbOKOnly + vbExclamation, "提示！"
            Unload Me
            End If
            Exit Sub
        Else
            MsgBox "數據庫中沒有記錄！", vbOKOnly + vbExclamation, "提示！"
            Me.ZOrder 0
        End If
    End If
Command1_Click_Error:
    Exit Sub
End Sub

Private Sub cmdPath_Click()
    CommonDialog1.CancelError = True
On Error GoTo ErrHandler
    CommonDialog1.Flags = cdlOFNHideReadOnly
    CommonDialog1.Filter = "All Files (*.*)|*.*|Excel Files" & _
    "(*.xls)|*.xls"
    CommonDialog1.FilterIndex = 2
    CommonDialog1.ShowSave
    Me.textFilePath = CommonDialog1.FileName
    strFilepath = CommonDialog1.FileName                            '設置保存路徑
    Exit Sub

ErrHandler:
    Exit Sub
End Sub

Private Sub Form_Load()
    Me.textFilePath = ""
End Sub