推薦：從Access數據庫到SQL Server高手
之前編寫軟件都是ASP+Access，由于看到SQL Server數據庫中的一些功能確實高過ACCESS，具體如下： 1、觸發器： 有了觸發器，也就是可以在增加一個數據的時候對應調用一個過程來維護數據庫的完整性。 2、視圖： 這個是我對SQL Server最感興趣的一個功能，通過

有些軟件，或者數據庫支持將Excel中的內容導入到數據庫中，然后可以乘勝sql語句，但是真正的想要達到自己的目的，還真的需要自己下一番功夫。而office中的好多東西都可以用到vbs，特別是excel這種有一定規則的軟件。因此，我記錄下部分用于演示的代碼，待以后慢慢研究。

****************************************************************************************************************************************

代碼一：其實是將sheet1中有一定規律的數據（數據庫表名稱以及后面跟著的該表的字段），映射到sheet2中。sheet2針對于sheet1來說，更像是一個目錄。

****************************************************************************************************************************************

Option Explicit

'Author: LiSheng Feng (eBis)
Sub SyncIndex()
    Sheets(2).Cells.Clear
   
    Dim LinkCurrentRow As Long
    LinkCurrentRow = 1
   
    Dim CellString As String
    Dim LinkName As String
   
    Dim i As Integer
    For i = 2 To Sheets(1).Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row
        If Sheets(1).Cells(i, 1) = "" Then
            CellString = UCase(Sheets(1).Cells(i, 2))
           
            If CellString <> "" Then
                If InStr(CellString, " VIEW ") = 0 Then
                    If Not (Left(CellString, 3) = "IX_" Or InStr(CellString, "IDX") > 0 Or InStr(CellString, "INDEX") > 0) Then
                        LinkName = Sheets(1).Cells(i, 3)
                       
                        If LinkName = "" Then
                            LinkName = CellString
                        End If
                       
                        Sheets(2).Hyperlinks.Add Anchor:=Sheets(2).Cells(LinkCurrentRow, 1), Address:="", _
                                    SubAddress:=Sheets(1).Name + "!B" + CStr(i), TextToDisplay:=LinkName
                       
                       
                        Sheets(2).Cells(LinkCurrentRow, 2) = UCase(Sheets(1).Cells(i, 2))
                        LinkCurrentRow = LinkCurrentRow + 1
                    End If
                End If
            End If
        End If
    Next i
   
    Sheets(2).Columns(1).AutoFit
    Sheets(2).Columns(2).AutoFit
   
    MsgBox "同步完成", vbOKOnly + vbInformation
End Sub

****************************************************************************************************************************************

代碼二：將sheet1中多個數據庫的表結構標稱sql語句

****************************************************************************************************************************************
Sub createSql()
   
Sheets(5).Cells.Clear
   
    Dim LinkCurrentRow As Long
    LinkCurrentRow = 1
   
    Dim CellString As String
    Dim LinkName As String
   
    Dim i As Integer
   
    Dim sqlStr As String
   
    Dim tblName As String
   
    Dim tblStart As Boolean
    Dim tblCount As Integer
    Dim tblSql As String
   
    Dim fldName As String '字段名稱
    Dim fldType As String '字段類型
   
   
    tblStart = False
    tblCount = 0
   
    For i = 2 To Sheets(1).Cells(1, 1).SpecialCells(xlCellTypeLastCell).Row
       
        If Sheets(1).Cells(i, 1) = "" Then  '表名
           
            If Sheets(1).Cells(i, 3) <> "" Then '剔除IDX
                If tblCount <> 0 Then
                    Sheets(5).Cells(tblCount + 1, 1) = Left(tblSql, Len(tblSql) - 2) & ") ON [PRIMARY]" '刪除最有一個,和回車后增加語句
                    tblSql = ""
                End If
               
                tblCount = tblCount + 1
                tblName = Sheets(1).Cells(i, 2)
                tblSql = "Create TABLE dbo.[" & tblName & "]("
            End If
        Else    '字段名稱
            'eg: "[ShipName_EN] [nvarchar](100) COLLATE Chinese_PRC_CI_AS NOT NULL,"
            fldName = "[" & Sheets(1).Cells(i, 2) & "]"
            fldType = GetFieldType(Sheets(1).Cells(i, 4))
               
            If fldName <> "" Then
                tblSql = tblSql & fldName & " " & fldType & "," & vbCr
            End If
        End If
       
       
       
    Next i

End Sub

Function GetFieldType(s As String) As String
Dim ret As String
Dim idxlft, idxrgt As Integer

    If s <> "" Then
        idxlft = InStr(s, "(")
        idxrgt = InStr(s, ")")
       
        If (idxlft > 0) And (idxrgt > 0) Then
            ret = "[" & Mid(s, 1, idxlft - 1) & "]" & Mid(s, idxlft, Len(s) - idxlft + 1)
        Else
            ret = s
        End If
               
    End If
   
    GetFieldType = ret

End Function

****************************************************************************************************************************************

代碼三：根據數據庫表中的數據（不再是表結構，而是數據），生成sql語句并保存到文件中。

****************************************************************************************************************************************

'最大行數
Const MAX_NUM_ROW = 5000

'導出文件路徑所在單元格
Const PATH_OUTPUT_ROW = 3
Const PATH_OUTPUT_COL = 3

'定義列常量
Const NAME_COL = 1
Const GENDER_COL = 2
Const PHONE_COL = 3
Const EMAIL_COL = 4

'讀取數據開始行數
Const START_ROW = 5

'定義數據實體類
Private Type Tmplt
NAME As String
GENDER As String
PHONE As String
EMAIL As String
End Type

'行數變量
Dim noOfTmplts As Integer

'數據實體類數組
Dim TmpltArray(MAX_NUM_ROW) As Tmplt

'點擊按鈕觸發事件
Private Sub CommandButton1_Click()
generateSQL
End Sub

'生成SQL
Private Sub generateSQL()
makedir
initData
writeToFile
End Sub

'構建文件輸出路徑
Private Sub makedir()
On Error Resume Next
MkDir Sheet1.Cells(PATH_OUTPUT_ROW, PATH_OUTPUT_COL)
End Sub

'讀取Excel數據，填充實體類數組
Private Sub initData()

Erase TmpltArray
noOfTmplts = 0

Dim j As Integer

'循環讀取Excel數據行
For j = START_ROW To MAX_NUM_ROW

TmpltArray(noOfTmplts).NAME = Sheet1.Cells(j, NAME_COL)
TmpltArray(noOfTmplts).GENDER = Sheet1.Cells(j, GENDER_COL)
TmpltArray(noOfTmplts).PHONE = Sheet1.Cells(j, PHONE_COL)
TmpltArray(noOfTmplts).EMAIL = Sheet1.Cells(j, EMAIL_COL)
noOfTmplts = noOfTmplts + 1

Next
End Sub

'讀取實體類數組,生成SQL并寫入文件
Private Sub writeToFile()

Dim lvOutputPath As String

'輸出文件路徑
lvOutputPath = Sheet1.Cells(PATH_OUTPUT_ROW, PATH_OUTPUT_COL)

If lvOutputPath = "" Then
MsgBox "沒有找到輸出文件路徑！"
Exit Sub
End If

fileNum = FreeFile

'打開輸出文件
Open lvOutputPath For Output As fileNum

Dim lvUserSql As String
Dim nameStr As String
Dim genderStr As String
Dim phoneStr As String
Dim emailStr As String

'循環生成SQL
For j = 0 To noOfTmplts - 1

nameStr = TmpltArray(j).NAME
genderStr = TmpltArray(j).GENDER
phoneStr = TmpltArray(j).PHONE
emailStr = TmpltArray(j).EMAIL

If nameStr <> "" Then
lvUserSql = "Insert into Students(name,gender,phone,email) values('" & nameStr & "','" & genderStr & "','" & phoneStr & "','" & emailStr & "');"
Print #fileNum, lvUserSql
End If
Next

Close fileNum

MsgBox "文件生成完成！"

Exit Sub

Err_Open_File:
Close lvFileNum

If Err.Number = 76 Then
'路徑未找到
MsgBox Err.Description
Exit Sub

Else
MsgBox Err.Description
Exit Sub
End If

End Sub

****************************************************************************************************************************************

這些代碼都是卸載宏里面的，到時候執行宏就可以了。

分享：解讀五種查詢數據庫中重復記錄的方法
1、查找表中多余的重復記錄，重復記錄是根據單個字段（peopleId）來判斷 select*frompeople wherepeopleIdin(selectpeopleIdfrompeoplegroupbypeopleIdhavingcount (peopleId)1) 2、刪除表中多余的重復記錄，重復記錄是根據單個字段（peopleId）來判斷，只留