作者:Cooly '======================================================= Public isDB As Boolean Private Sub Form_Load() Adodc1.Recordset.MoveFirst Private Sub List1_Click() '选择DataGrid中显示的字段 sql = "select " If Trim(sql1) = "" Then sql = sql & sql1 & " from tableabc" Adodc1.RecordSource = sql '======================================================== Private Sub Command1_Click() End Sub Private Sub Form_Load() Open "C:\command.com" For Binary Access Read As #1 '======================================================== c = 0 '======================================================== Private Sub Dir1_Change() Private Sub Drive1_Change() Private Sub File1_Click() '======================================================== Private Sub Command1_Click() Private Sub Command2_Click() '======================================================== Private Sub DataGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Private Sub Form_Load() '======================================================== Private Sub Form_Load() Set conn = New ADODB.Connection rst.CursorLocation = adUseClient rst.Open "select * from table1", conn, adOpenDynamic, adLockOptimistic End Sub '======================================================== Private Sub Command2_Click() Set fso = Nothing '======================================================== Private Sub Command1_Click() Private Sub Command2_Click() For i = 1 To Len(a) Private Sub Form_Load() Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) '======================================================== '======================================================== Option Explicit Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long DSNName = "myodbc" strDriver = "C:\\WINNT\\System32\\sqlsrv32.dll" 'SQL Server的驱动,如果用VFP可以改成相应的文件 RegCreateKey HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources", hKey RegCreateKey HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & DSNName, hKey '======================================================== Private Sub Form_Load() Set nodX = TreeView1.Nodes.Add(, , "r", "报表组 ") '======================================================== filepath = "c:\words" Set fso = CreateObject("Scripting.FileSystemObject") Set folders = fso.GetFolder(filepath) I = 0 End Sub Private Sub Command2_Click() wrdRows = 10: wrdCols = 10 Set wrdApp = CreateObject("Word.Application") wrdApp.ActiveDocument.Content.GoTo What:=3, Which:=2, Count:=wrdRows wrdApp.ActiveDocument.Save Set wrdApp = Nothing End Sub
出处:http://search.csdn.net/expert/topic/51/5101/2003/3/20/1555609.htm
'一、如何使用ADODC控件绑定数据到DataGrid和DataList
'=======================================================
Dim connStr, AccessLocation As String
AccessLocation = "C:\db1.mdb"
connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & AccessLocation & ";Persist Security Info=False"
Adodc1.ConnectionString = connStr
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select * from tableabc"
Adodc1.Refresh
For i = 0 To Adodc1.Recordset.Fields.Count - 1
List1.AddItem Adodc1.Recordset.Fields(i).Name
Next
Set DataList1.DataSource = Adodc1
DataList1.DataField = "Col1"
DataList1.BoundColumn = "Col1"
Set DataList1.RowSource = Adodc1
DataList1.ListField = "Col1"
End Sub
Dim sql, sql1 As String
For i = 0 To List1.ListCount - 1
If List1.Selected(i) Then
If Trim(sql1) = "" Then
sql1 = List1.List(i)
Else
sql1 = sql1 & ", " & List1.List(i)
End If
End If
Next
sql1 = "*"
End If
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
End Sub
'二、如何对文件进行二进制读写
'========================================================
Dim getValue() As Byte
Open "C:\1.cmd" For Binary Access Write As #2
Put #2, , getValue()
Close #2
ReDim getValue(FileLen("C:\command.com"))
Get #1, , getValue
Close #1
End Sub
'三、字符串处理算法(1)
' 求出已知字符串中出现频率最高的字串内容及出现次数
'========================================================
Private Sub Command1_Click()
Dim a, b As String
Dim i As Long
Dim c, t As Long
a = "abcdefcdedgcdeethcdenbicde"
For i = 1 To Len(a)
t = 0
b = a
If i = Len(a) - 2 Then Exit For
Do Until InStr(b, Mid(a, i, 3)) = 0
b = Right(b, Len(b) - InStr(b, Mid(a, i, 3)))
t = t + 1
Loop
If t > c Then
c = t
End If
Next
MsgBox c
End Sub
'四、DriveListBox,DirListBox,FileListBox三个控件的使用
'========================================================
File1.Path = Dir1.Path
End Sub
Dir1.Path = Drive1.Drive
End Sub
Text1.Text = File1.Path & "\" & File1.FileName
End Sub
'五、如何对目录进行操作 (使用FSO)
'========================================================
Dim fso As Object
Dim SourcePath, TargetPath As String
SourcePath = Text1.Text
TargetPath = Text2.Text
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(TargetPath) Then
fso.CopyFolder SourcePath & "*.*", TargetPath
fso.CopyFile SourcePath & "*.*", TargetPath
Else
fso.CreateFolder (TargetPath)
fso.CopyFolder SourcePath & "*.*", TargetPath
fso.CopyFile SourcePath & "*.*", TargetPath
End If
Set fso = Nothing
MsgBox "复制完成"
End Sub
Dim fso As Object
Dim TargetPath As String
TargetPath = "D:\Test"
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFolder TargetPath, True
Set fso = Nothing
MsgBox "删除成功"
End Sub
'六、如何取出DataGrid控件选定行的内容
'========================================================
DataGrid1.Row = DataGrid1.RowContaining(Y)
MsgBox DataGrid1.Columns(0).Text
End Sub
Adodc1.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=test;Data Source=SERVER"
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = "select * from test"
Adodc1.Refresh
Set DataGrid1.DataSource = Adodc1
DataGrid1.AllowUpdate = False
End Sub
'七、如何ADODB对象绑定DataGrid控件
'========================================================
Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
conn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=test;Data Source=SERVER"
conn.Open , "sa"
Set DataGrid1.DataSource = rst
'八、日期函数的使用以及使用FileExists判断文件是否存在
'========================================================
Private Sub Command1_Click()
If IsNumeric(Text1.Text) And InStr(Text1.Text, ".") = 0 And InStr(Text1.Text, "-") = 0 Then
If CLng(Text1.Text) > 0 And CLng(Text1.Text) <= 12 Then
MsgBox DateDiff("d", DateSerial(Year(Now()), Text1.Text, 1), DateAdd("m", 1, DateSerial(Year(Now()), Text1.Text, 1)))
Else
MsgBox "Error"
End If
Else
MsgBox "Error, Wrong Value"
End If
End Sub
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists("C:\command.com") = True Then
MsgBox "C:\Command.com 文件已存在"
Else
MsgBox "C:\Command.com 文件不存在"
End If
End Sub
'九、十进制与二进制的简单算法。
'========================================================
Dim a, b As Long
Dim c As String
a = Text1.Text
Do
If a = 0 Then Exit Do
If a > 1 Then
b = a Mod 2
Else
b = a
End If
c = CStr(b) & CStr(c)
a = a \ 2
Loop
Text2.Text = c
End Sub
Dim a, b As String
Dim i, c, d As Long
a = Text2.Text
c = CLng(Mid(a, i, 1))
If c = 1 Then
d = d + 2 ^ (Len(a) - i)
End If
Next
Text3.Text = d
End Sub
'========================================================
'十七、在容器中移动控件
'========================================================
Public isMove As Boolean
Public bX, bY As Long
isMove = False
End Sub
If Button = 1 Then
isMove = True
bX = X
bY = Y
End If
End Sub
If Button = 1 And isMove Then
Label1.Move X + Label1.Left - bX, Y + Label1.Top - bY
End If
End Sub
isMove = False
End Sub
'十八、如何在运行程序的时候获得外部参数
'========================================================
Private Sub Form_Load()
Dim ParaArray() As String
Dim GetString As String
Dim I As Long
GetString = Trim(Command())
If InStr(GetString, "/") = 1 Then
If Len(GetString) > 1 Then
GetString = Right(GetString, Len(GetString) - 1)
ParaArray = Split(GetString, "/", -1, vbTextCompare)
For I = 0 To UBound(ParaArray())
MsgBox "Parameter " & I + 1 & ": = " & Trim(ParaArray(I))
Next
Else
MsgBox "Empty Parameter!"
End If
Else
If InStr(GetString, "/") = 0 Then
MsgBox "No Parameter! "
Else
MsgBox "Wrong Format"
End If
End If
End Sub
'十九、注册表的操作
'========================================================
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_DYN_DATA = &H80000006
Const REG_NONE = 0
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_MULTI_SZ = 7
Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Sub Command1_Click()
Dim hKey As Long
Dim DSNName, strDriver, strServer, strDatabase, strLastUser, strDBType As String
strServer = "SERVER"
strDatabase = "test"
strLastUser = "sa"
strDBType = "SQL Server"
RegSetValueEx hKey, DSNName, 0, REG_SZ, ByVal strDBType, Len(strDBType) + 1
RegSetValueEx hKey, "Driver", 0, REG_EXPAND_SZ, ByVal CStr(strDriver), Len(strDriver) + 1
RegSetValueEx hKey, "Server", 0, REG_SZ, ByVal CStr(strServer), Len(strServer) + 1
RegSetValueEx hKey, "Database", 0, REG_SZ, ByVal CStr(strDatabase), Len(strDatabase) + 1
RegSetValueEx hKey, "LastUser", 0, REG_SZ, ByVal CStr(strLastUser), Len(strLastUser) + 1
End Sub
'二十、TreeView的使用,及选中其中指定的节点
'========================================================
Private Sub Command1_Click()
Dim nodeY As Node
For Each nodeY In TreeView1.Nodes
If CStr(Trim(nodeY.Text)) = "ff" Then
nodeY.Selected = True
TreeView1.SetFocus
Exit For
End If
Next
End Sub
Rs1.CommandType = adCmdText
Rs1.RecordSource = "select distinct biao,zu from test order by zu"
Rs1.Refresh
Dim Rs As ADODB.Recordset
Set Rs = Rs1.Recordset
i = 0
Dim TempString As String
Dim TempKey As Long
Do Until Rs.EOF Or Rs.BOF
If TempString = Rs!zu Then
Set nodeX = TreeView1.Nodes.Add("Z" & TempKey, tvwChild, "B" & i, Rs!biao)
Else
Set nodX = TreeView1.Nodes.Add("r", tvwChild, "Z" & i, Rs!zu)
Set nodeX = TreeView1.Nodes.Add("Z" & i, tvwChild, "B" & i, Rs!biao)
TempString = Rs!zu
TempKey = i
End If
Rs.MoveNext
i = i + 1
Loop
End Sub
'二十一、Word对象的使用(查找Word文档中是否包含指定关键字,
'以及在指定位置插入字符串)
'========================================================
Private Sub Command1_Click()
Dim wrdApp As Object
Dim f, fso As Object
Dim filepath As String
Dim Keywords As String
Keywords = "abc"
For Each f In folders.Files
If LCase(Right(f.Name, Len(f.Name) - InStrRev(f.Name, "."))) = "doc" Then
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = False
wrdApp.Documents.Open FileName:=filepath & "\" & f.Name
If InStr(wrdApp.ActiveDocument.Content.Text, Keywords) <> 0 Then
MsgBox f.Name
End If
wrdApp.Quit
End If
Next
Set wrdApp = Nothing
Dim wrdApp As Object
Dim wrdRows, wrdCols, I As Long
Dim insText As String
insText = "TEST"
wrdApp.Visible = False
wrdApp.Documents.Open FileName:="C:\words\1.doc"
For I = 1 To wrdRows
wrdApp.ActiveDocument.Content.insertAfter vbCrLf
Next
wrdApp.ActiveDocument.Content.insertAfter Space(wrdCols) & "PPPPPPPPPPPPP"
wrdApp.Quit
更多请看原贴:http://expert.csdn.net/Expert/topic/1555/1555609.xml?temp=.3376276
正文
想用就用,VB基础代码(精)2005-10-11 21:01:00
【评论】 【打印】 【字体:大 中 小】 本文链接:http://blog.pfan.cn/iamben250/5933.html
阅读(1967) | 评论(0)
版权声明:编程爱好者网站为此博客服务提供商,如本文牵涉到版权问题,编程爱好者网站不承担相关责任,如有版权问题请直接与本文作者联系解决。谢谢!
评论