簡單顯示資料的方法

'此處需要1個DataGrid(DataGrid1)
Option Explicit
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset

Private Sub Form_Load()
Dim strFile As String
strFile = "C:\temp\db1.mdb"
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile & ";Persist Security Info=False"
'開啟資料庫連線,此處為開啟Access 資料庫,其他資料庫的連線請查MSDN
rs.CursorLocation = adUseClient
'設定或傳回資料指標服務的位置,詳細資料請查MSDN
rs.Open "Select * From test1", cn, adOpenKeyset, adLockOptimistic
'adOpenKeyset,adLockOptimistic分別代表指標型態及鎖定型態,詳細資料請查MSDN
Set DataGrid1.DataSource = rs '將資料來源設定給DataGrid
DataGrid1.Refresh
End Sub

如何讀取文字檔

'這裡需要一個Button

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
MessageBox.Show(GetTextString)

End Sub

Private Function GetTextString() As String
Dim value As String = ""
Dim a As String = ""
Dim MySF As StreamReader = New StreamReader("c:\1.txt", System.Text.Encoding.Default)

'value = MySF.ReadToEnd() '讀取全部會包含換行符號
Do While Not MySF.EndOfStream
value &= MySF.ReadLine '讀取單行
Loop
Return value
End Function

Access如何做出交叉資料表

可以利用Access 提供的函數TransForm 來達成

範例:

TRANSFORM max(t2)
SELECT t1
FROM test1
GROUP BY t1
PIVOT t3

如何用VBA 將Excel A資料匯到Excel B

'此處需要1個CommandButton

Option Explicit
Dim cn As New ADODB.Connection
Dim cn2 As New ADODB.Connection
Dim xlsFileName As String
Dim xlsFileName2 As String

Private Sub Command1_Click()
Dim SheetName As String
SheetName = "Sheet1"
cn.Execute "Select * Into [Excel 8.0;DATABASE=" & xlsFileName2 & "].[Sheet1] From (Select * from [" & SheetName & "$] " '將資料匯到 xlsFileName2
End Sub

Private Sub Form_Load()
xlsFileName = "C:\temp\123.xls"
xlsFileName2 = "C:\temp\456.xls"
On Error Resume Next
Kill xlsFileName2
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & xlsFileName & ";" & _
"Extended Properties=""Excel 8.0;IMEX=1;"";" & _
"Persist Security Info=False"

End Sub

發mail

'這裡需要一個Button

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim newMail As New System.Net.Mail.MailMessage
Dim ToAddress(,) As String = {{"to@yahoo.com.tw", "to"}, {"to@msa.hinet.net", "to"}}
Dim CCAddress(,) As String = {{"cc@yahoo.com.tw", "cc"}, {"cc@msa.hinet.net", "cc"}}
Dim BccAddress(,) As String = {{"bcc@yahoo.com.tw", "bcc"}, {"bcc@msa.hinet.net", "bcc"}}
Dim AttachFile() As String = {"C:\temp\123.xls", "C:\temp\456.xls"}
Dim smtpMail As New System.Net.Mail.SmtpClient

With newMail
.From = New System.Net.Mail.MailAddress("from@msa.hinet.net", "from") '寄件者
.Body = "Hello Every Body!!" '內文
.Subject = "測試資料!!" '主旨
.BodyEncoding = System.Text.Encoding.GetEncoding("BIG5") '編碼方式

For i As Int32 = 0 To ToAddress.GetUpperBound(1) '收信人
.To.Add(New System.Net.Mail.MailAddress(ToAddress(i, 0), ToAddress(i, 1)))
Next
For i As Int32 = 0 To CCAddress.GetUpperBound(1) '副本
.CC.Add(New System.Net.Mail.MailAddress(CCAddress(i, 0), CCAddress(i, 1)))
Next
For i As Int32 = 0 To BccAddress.GetUpperBound(1) '密件副本
.Bcc.Add(New System.Net.Mail.MailAddress(BccAddress(i, 0), BccAddress(i, 1)))
Next
For i As Int32 = 0 To BccAddress.GetUpperBound(1) '夾檔
.Attachments.Add(New System.Net.Mail.Attachment(AttachFile(i)))
Next
.IsBodyHtml = True '是否為HTML格式
.Priority = Net.Mail.MailPriority.Normal '優先權
End With
Try
smtpMail.Host = "msa.hinet.net"
smtpMail.SendAsync(newMail, "TEST")
Catch ex As Exception
MsgBox(ex.InnerException)
End Try
End Sub

簡單的新增刪除修改查詢的程式

Public Class SampleForm2
Enum uEditMode '列舉值
Insert = 0
Edit = 1
View = 2
Delete = 3
End Enum

Dim cn As New Data.OleDb.OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\temp\db1.mdb;Persist Security Info=False")
Dim da As New OleDb.OleDbDataAdapter
Dim cb As New OleDb.OleDbCommandBuilder
Dim dt As New Data.DataTable("Demo")
Dim lngEditMode As uEditMode
Dim strCaption() As String
Dim WithEvents myBindingManagerBase As BindingManagerBase

Private Sub BindingManagerBase_PositionChanged(ByVal sender As Object, ByVal e As EventArgs) Handles myBindingManagerBase.PositionChanged
RcdToScr()
End Sub

'Private Sub MoveNext()
' myBindingManagerBase.Position += 1
'End Sub

'Private Sub MovePrevious()
' myBindingManagerBase.Position -= 1
'End Sub

'Private Sub MoveFirst()
' myBindingManagerBase.Position = 0
'End Sub

'Private Sub MoveLast()
' myBindingManagerBase.Position = myBindingManagerBase.Count - 1
'End Sub


Private Sub SampleForm2_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
InitComm()
DataBind()
End Sub

Private Sub SetCaption()
Try
strCaption = Split("員工編號,員工姓名,到職日期,地址,備註", ",")
lblEmpNo.Text = strCaption(0) '設定Label 的Caption
lblEmpName.Text = strCaption(1)
lblEntryDate.Text = strCaption(2)
lblAddress.Text = strCaption(3)
lblNote.Text = strCaption(4)

lblFindEmpNo.Text = strCaption(0) '設定Label 的Caption
lblFindEmpName.Text = strCaption(1)
lblFindEntryDate.Text = strCaption(2)
lblFindAddress.Text = strCaption(3)
lblFindNote.Text = strCaption(4)

For i As Int32 = 0 To UBound(strCaption) '設定DataGrid 的Caption
dgdData.Columns(i + 1).HeaderText = strCaption(i)
Next
Catch ex As Exception
ErrHandle(ex)
End Try
End Sub

'加入錯誤處理
Private Sub ErrHandle(ByVal ex As Exception)
MsgBox("[程式錯誤]-錯誤原因:" & ex.Message, vbCritical, "提示")
End Sub

Private Sub InitComm()
ChangeMode(uEditMode.View)
End Sub

'清空資料
Private Sub NewRcd()
Try
txtEmpNo.Clear()
txtEmpName.Clear()
txtEntryDate.Clear()
txtAddress.Clear()
txtNote.Clear()
txtEmpNo.Focus()
Catch ex As Exception
ErrHandle(ex)
End Try
End Sub

Private Sub RcdToScr()
Try
With dt
If myBindingManagerBase.Position < 0 Then Exit Try txtEmpNo.Text = .Rows(myBindingManagerBase.Position).Item("EmpNo").ToString txtEmpName.Text = .Rows(myBindingManagerBase.Position).Item("EmpName").ToString txtEntryDate.Text = .Rows(myBindingManagerBase.Position).Item("EntryDate").ToString txtAddress.Text = .Rows(myBindingManagerBase.Position).Item("Address").ToString txtNote.Text = .Rows(myBindingManagerBase.Position).Item("Note").ToString End With Catch ex As Exception ErrHandle(ex) End Try End Sub Private Sub ScrToRcd() Try Dim objRow As DataRow = Nothing If lngEditMode = uEditMode.Insert Then objRow = dt.NewRow '如果為新增模式則新增一筆資料 Else objRow = dt.Rows(myBindingManagerBase.Position) End If With objRow .Item("EmpNo") = GetValue(txtEmpNo.Text) .Item("EmpName") = GetValue(txtEmpName.Text) .Item("EntryDate") = GetValue(txtEntryDate.Text) .Item("Address") = GetValue(txtAddress.Text) .Item("Note") = GetValue(txtNote.Text) End With dt.Rows.Add(objRow) da.Update(dt) Catch ex As Exception ErrHandle(ex) End Try End Sub Private Function GetValue(ByVal Value As Object) As System.Object Dim tmpValue As Object = Nothing If Value.ToString.Length = 0 Then tmpValue = Convert.DBNull Else tmpValue = Value End If Return tmpValue End Function Private Sub DataBind() '繫結資料 Try Dim strWhere As String = "" OpenData() cb = New Data.OleDb.OleDbCommandBuilder(da) cb.QuotePrefix = "[" cb.QuoteSuffix = "]" dt.Clear() da.Fill(dt) myBindingManagerBase = Me.BindingContext(dt) Me.dgdData.DataSource = dt Me.dgdData.Refresh() If dt.Columns.Count > 0 Then dt.Columns("KeyNo").ReadOnly = True
If dgdData.Columns.Count > 0 Then dgdData.Columns("KeyNo").Visible = False
SetCaption()

Catch ex As Exception
ErrHandle(ex)
End Try

BindingManagerBase_PositionChanged(Me, System.EventArgs.Empty)

End Sub

Private Sub OpenData()
da = New Data.OleDb.OleDbDataAdapter
Dim cmd As New OleDb.OleDbCommand

Dim strWhere As String = ""
If Me.txtFindEmpNo1.Text.Length > 0 Then
cmd.Parameters.Add("EmpNo1", OleDb.OleDbType.Decimal).Value = txtFindEmpNo1.Text
strWhere &= " And [EmpNo] >= ?"
End If
If Me.txtFindEmpNo2.Text.Length > 0 Then
cmd.Parameters.Add("EmpNo1", OleDb.OleDbType.Decimal).Value = txtFindEmpNo2.Text
strWhere &= " And [EmpNo] <= ?" End If If Me.txtFindEmpName1.Text.Length > 0 Then
cmd.Parameters.Add("EmpNo1", OleDb.OleDbType.BSTR, 10).Value = txtFindEmpName1.Text
strWhere &= " And [EmpName] >= ?"
End If
If Me.txtFindEmpName2.Text.Length > 0 Then
cmd.Parameters.Add("EmpNo1", OleDb.OleDbType.BSTR, 10).Value = txtFindEmpName2.Text
strWhere &= " And [EmpName] <= ?" End If If Me.txtFindEntryDate1.Text.Length > 0 Then
cmd.Parameters.Add("EmpNo1", OleDb.OleDbType.Date).Value = txtFindEntryDate1.Text
strWhere &= " And [EntryDate] >= ?"
End If
If Me.txtFindEntryDate2.Text.Length > 0 Then
cmd.Parameters.Add("EmpNo1", OleDb.OleDbType.Date).Value = txtFindEntryDate2.Text
strWhere &= " And [EntryDate] <= ?" End If If Me.txtFindNote.Text.Length > 0 Then
cmd.Parameters.Add("EmpNo1", OleDb.OleDbType.BSTR, 10).Value = txtFindNote.Text
strWhere &= " And [Note] like '%' + ? + '%'"
End If
If Me.txtFindAddress.Text.Length > 0 Then
cmd.Parameters.Add("EmpNo1", OleDb.OleDbType.BSTR, 10).Value = txtFindAddress.Text
strWhere &= " And [Address] like '%' + ? + '%'"
End If

cmd.CommandText = "Select [KeyNo],[EmpNo],[EmpName],[EntryDate],[Address],[Note] From [Demo] "
If strWhere.Length > 0 Then cmd.CommandText &= " Where " & strWhere.Substring(4)
cmd.Connection = cn
da.SelectCommand = cmd
End Sub

Private Sub dtnUpdate_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnSave.Click
If Not IsDataOk() Then Exit Sub
ScrToRcd()
If lngEditMode = uEditMode.Insert Then
btnAdd_Click(Me, System.EventArgs.Empty)
Else
ChangeMode(uEditMode.View)
End If
End Sub

Private Function IsDataOk() As Boolean '撰寫檢查的條件
Try

Catch ex As Exception

End Try
Return True
End Function

Private Sub cmdCancel_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnExit.Click
If lngEditMode = uEditMode.View Then
Me.Dispose()
Else
DataBind()
End If
End Sub

Private Sub btnExit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExit.Click
Me.Dispose()
End Sub

Private Sub btnAdd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnAdd.Click
Call ChangeMode(uEditMode.Insert)
NewRcd()

End Sub

Private Sub ChangeMode(ByVal lngMode As uEditMode)
Try
Dim blnFlag As Boolean
lngEditMode = lngMode
Select Case lngMode
Case uEditMode.Insert '新增
blnFlag = True
btnExit.Text = "取消(&X)"
Case uEditMode.Edit '修改
blnFlag = True
btnExit.Text = "取消(&X)"
Case uEditMode.View '顯示
blnFlag = False
btnExit.Text = "結束(&X)"
End Select
gbxData.Enabled = blnFlag
dgdData.Enabled = Not blnFlag
btnAdd.Enabled = Not blnFlag
btnEdit.Enabled = Not blnFlag
btnSave.Enabled = blnFlag
btnDelete.Enabled = Not blnFlag
btnPrint.Enabled = Not blnFlag

Catch ex As Exception
ErrHandle(ex)

End Try
End Sub

Private Sub btnEdit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnEdit.Click
Call ChangeMode(uEditMode.Edit)

End Sub

Private Sub btnDelete_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnDelete.Click
If MessageBox.Show("確定要刪除??", "提示!!", MessageBoxButtons.YesNo) = Windows.Forms.DialogResult.Yes Then
dt.Rows(myBindingManagerBase.Position).Delete()
da.Update(dt)
BindingManagerBase_PositionChanged(Me, System.EventArgs.Empty)
End If
End Sub

Private Sub lblEmpNo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles lblEmpNo.Click

End Sub

Private Sub btnFind_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnFind.Click
DataBind()
End Sub
End Class

將Excel資料匯出到Access 資料庫

Sub test()
Dim cn As Object
Dim rs As Object
Dim rs2 As Object
Dim i As Long
Dim iCount As Long
Set cn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
Set rs2 = CreateObject("adodb.recordset")
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\temp\db1.mdb;Persist Security Info=False"
rs.cursorlocation = 3
rs.Open "Select * From NewData", cn, 1, 3
For i = 1 To 65535
iCount = 0
If Range("A" & i).Text <> "" Then
If rs2.State = 1 Then rs2.Close
rs2.cursorlocation = 3
rs2.Open "Select * From NewData where [編號]=" & Range("A" & i).Text, cn, 0, 1 '數字要這樣
'rs2.Open "Select * From NewData where 編號='" & Range("A" & i).Text & "'", cn, 0, 1 '文字改這樣
iCount = rs2.RecordCount
End If
If iCount = 0 Then
rs.addnew
rs("編號") = IIf(Range("A" & i).Text = "", Null, Range("A" & i).Text)
End If
rs("名稱") = IIf(Range("B" & i).Text = "", Null, Range("B" & i).Text)
rs("數量") = IIf(Range("C" & i).Text = "", Null, Range("C" & i).Text)
If rs("編號") & "" = "" And rs("名稱") & "" = "" And rs("數量") & "" = "" Then
rs.cancelupdate
Exit For
End If
rs.Update
Next
End Sub

如何使用Command 物件更新資料...

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Dim cn As New OleDb.OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\temp\db1.mdb;Persist Security Info=False")
Dim cmd As New Data.OleDb.OleDbCommand
With cmd
cn.Open()
.CommandText = "Update test1 set t2=?,t3=? where t1=?"
.Connection = cn
.Parameters.Add("t1", OleDb.OleDbType.Decimal)
.Parameters.Add("t2", OleDb.OleDbType.BSTR)
.Parameters.Add("t3", OleDb.OleDbType.DBDate)

.Parameters.Item(0).Value = TextBox1.Text
.Parameters.Item(1).Value = TextBox2.Text
.Parameters.Item(2).Value = Convert.ToDateTime(TextBox3.Text)
.ExecuteNonQuery()
cn.Close()
End With
End Sub