有些軟件，或者數(shù)據(jù)庫支持將Excel中的內(nèi)容導(dǎo)入到數(shù)據(jù)庫中，然后可以乘勝sql語句，但是真正的想要達(dá)到自己的目的，還真的需要自己下一番功夫。而office中的好多東西都可以用到vbs，特別是excel這種有一定規(guī)則的軟件。因此，我記錄下部分用于演示的代碼，待以后慢慢研究。
****************************************************************************************************************************************
代碼一：其實是將sheet1中有一定規(guī)律的數(shù)據(jù)（數(shù)據(jù)庫表名稱以及后面跟著的該表的字段），映射到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中多個數(shù)據(jù)庫的表結(jié)構(gòu)標(biāo)稱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
****************************************************************************************************************************************
代碼三：根據(jù)數(shù)據(jù)庫表中的數(shù)據(jù)（不再是表結(jié)構(gòu)，而是數(shù)據(jù)），生成sql語句并保存到文件中。
****************************************************************************************************************************************
'最大行數(shù)
Const MAX_NUM_ROW = 5000
'導(dǎo)出文件路徑所在單元格
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
'讀取數(shù)據(jù)開始行數(shù)
Const START_ROW = 5
'定義數(shù)據(jù)實體類
Private Type Tmplt
NAME As String
GENDER As String
PHONE As String
EMAIL As String
End Type
'行數(shù)變量
Dim noOfTmplts As Integer
'數(shù)據(jù)實體類數(shù)組
Dim TmpltArray(MAX_NUM_ROW) As Tmplt
'點擊按鈕觸發(fā)事件
Private Sub CommandButton1_Click()
generateSQL
End Sub
'生成SQL
Private Sub generateSQL()
makedir
initData
writeToFile
End Sub
'構(gòu)建文件輸出路徑
Private Sub makedir()
On Error Resume Next
MkDir Sheet1.Cells(PATH_OUTPUT_ROW, PATH_OUTPUT_COL)
End Sub
'讀取Excel數(shù)據(jù)，填充實體類數(shù)組
Private Sub initData()
Erase TmpltArray
noOfTmplts = 0
Dim j As Integer
'循環(huán)讀取Excel數(shù)據(jù)行
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
'讀取實體類數(shù)組,生成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
'循環(huán)生成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
****************************************************************************************************************************************
這些代碼都是卸載宏里面的，到時候執(zhí)行宏就可以了。
新聞熱點
疑難解答
圖片精選
