Option Explicit
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 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
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

DSNName = "myodbc"

strDriver = "C:\\WINNT\\System32\\sqlsrv32.dll" ''''SQL Server的驱动,如果用VFP可以改成相应的文件
strServer = "SERVER"
strDatabase = "test"
strLastUser = "sa"
strDBType = "SQL Server"

RegCreateKey HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\ODBC Data Sources", hKey
RegSetValueEx hKey, DSNName, 0, REG_SZ, ByVal strDBType, Len(strDBType) + 1

RegCreateKey HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBC.INI\" & DSNName, hKey
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

Private Sub Form_Load()
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

    Set nodX = TreeView1.Nodes.Add(, , "r", "报表组  ")
   
    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

filepath = "c:\words"
Keywords = "abc"

Set fso = CreateObject("Scripting.FileSystemObject")

Set folders = fso.GetFolder(filepath)

I = 0
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

End Sub

Private Sub Command2_Click()
Dim wrdApp As Object
Dim wrdRows, wrdCols, I As Long
Dim insText As String

wrdRows = 10: wrdCols = 10
insText = "TEST"

Set wrdApp = CreateObject("Word.Application")
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.GoTo What:=3, Which:=2, Count:=wrdRows
wrdApp.ActiveDocument.Content.insertAfter Space(wrdCols) & "PPPPPPPPPPPPP"

wrdApp.ActiveDocument.Save
wrdApp.Quit

Set wrdApp = Nothing

End Sub


更多请看原贴：http://expert.csdn.net/Expert/topic/1555/1555609.xml?temp=.3376276

上一页  [1] [2]