即已知表名没有在代码中反应金沙js娱乐场官方网站,返回目录

怎样用SQL语句来判断已知表是否存在,通过Dao判断数据库中是否存在,SendMessage函数在RichTextBox中实现,下列代码能使RichTextBox有一次撤销操作的功能,返回目录

金沙js娱乐场官方网站 3

SELECT Count(*) AS QtyFROM MSysObjectsWHERE (((MSysObjects.Name) Like
需判断的已知表名));

‘常数
Public Const WM_USER = &H400
Public Const EM_HIDESELECTION = WM_USER + 63

 Copy Paste

Private Sub 命令0_Click()fExistTableEnd Sub

SendMessage函数在RichTextBox中实现:
一、一次撤销功能
二、无限地撤销功能

    1. 使用ADO打开Excel
      Sub Open_ExcelSpread()
         Dim conn As ADODB.Connection
         Set conn = New ADODB.Connection
         conn.Open “Provider=Microsoft.Jet.OLEDB.4.0;” & _
             “Data Source=” & CurrentProject.Path & _
             “\Report.xls;” & _
             “Extended Properties=Excel 8.0;”
         conn.Close
         Set conn = Nothing
      End Sub
    1. 使用SQL语句在用ADO打开的Excel中插入一行数据
      Public Sub WorksheetInsert()
        Dim Connection As ADODB.Connection
        Dim ConnectionString As String
        ConnectionString = “Provider=Microsoft.Jet.OLEDB.4.0;Data Source=” & ThisWorkbook.Path & “\Sales.xls;” & _
          “Extended Properties=Excel 8.0;”
          
        Dim SQL As String
          
        SQL = “INSERT INTO [Sales$] VALUES(‘VA’, ‘On’, ‘Computers’, ‘Mid’, 30)”

      Set Connection = New ADODB.Connection
      Call Connection.Open(ConnectionString)
        
      Call Connection.Execute(SQL, , CommandTypeEnum.adCmdText Or ExecuteOptionEnum.adExecuteNoRecords)
      Connection.Close
      Set Connection = Nothing
    End Sub

    1. 使用ADO从Access读取数据到Excel
      Public Sub SavedQuery()
          
        Dim Field As ADODB.Field
        Dim Recordset As ADODB.Recordset
        Dim Offset As Long
          
        Const ConnectionString As String = “Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\mydb.mdb;Persist Security Info=False”
          
        Set Recordset = New ADODB.Recordset
        Call Recordset.Open(“[Sales By Category]”, ConnectionString, _
          CursorTypeEnum.adOpenForwardOnly, LockTypeEnum.adLockReadOnly, _
          CommandTypeEnum.adCmdTable)

      If Not Recordset.EOF Then
        With Sheet1.Range(“A1”)
          For Each Field In Recordset.Fields
            .Offset(0, Offset).Value = Field.Name
            Offset = Offset + 1
          Next Field
          .Resize(1, Recordset.Fields.Count).Font.Bold = True
        End With
        Call Sheet1.Range(“A2”).CopyFromRecordset(Recordset)
        Sheet1.UsedRange.EntireColumn.AutoFit
      Else
        Debug.Print “Error: No records returned.”
      End If
      Recordset.Close
      Set Recordset = Nothing
    End Sub

    注意其中的CopyFromRecordSet方法,它可以从RecordSet中将数据直接读取到Excel的Range中,这比自己编写代码通过循环去填充Cell值要方便很多。如下面的方法就是通过循环读取值,然后通过Debug语句将读取到的值打印在Immediate窗口中。
    Sub openWorksheet()
       Dim myConnection As New ADODB.Connection
       Dim myRecordset As ADODB.Recordset
       
       myConnection.Open “Provider=Microsoft.Jet.OLEDB.4.0;” & _
          “Data Source=C:\myCustomers.xls;” & _
          “Extended Properties=Excel 8.0;”

          Set myRecordset = New ADODB.Recordset
          myRecordset.Open “customers”, myConnection, , , adCmdTable

          Do Until myRecordset.EOF
             Debug.Print myRecordset(“txtNumber”), myRecordset(“txtBookPurchased”)
             myRecordset.MoveNext
          Loop
    End Sub

    1. 将Access中的数据读取到Excel的一个例子
      Sub ExcelExample()
          Dim r As Integer, f As Integer
          Dim vrecs As Variant
          Dim rs As ADODB.Recordset
          Dim cn As ADODB.Connection
          Dim fld As ADODB.Field
          Set cn = New ADODB.Connection
          cn.Provider = “Microsoft OLE DB Provider for ODBC Drivers”
          cn.ConnectionString = “DRIVER={Microsoft Excel Driver (*.xls)};DBQ=C:\mydb.mdb;”
          cn.Open
          Debug.Print cn.ConnectionString
          Set rs = New ADODB.Recordset
          rs.CursorLocation = adUseClient
          rs.Open “SELECT * FROM Employees”, cn, adOpenDynamic, adLockOptimistic
          For Each fld In rs.Fields
              Debug.Print fld.Name,
          Next
          Debug.Print
          vrecs = rs.GetRows(6)
          For r = 0 To UBound(vrecs, 1)
              For f = 0 To UBound(vrecs, 2)
                  Debug.Print vrecs(f, r),
              Next
              Debug.Print
          Next
          Debug.Print “adAddNew: ” & rs.Supports(adAddNew)
          Debug.Print “adBookmark: ” & rs.Supports(adBookmark)
          Debug.Print “adDelete: ” & rs.Supports(adDelete)
          Debug.Print “adFind: ” & rs.Supports(adFind)
          Debug.Print “adUpdate: ” & rs.Supports(adUpdate)
          Debug.Print “adMovePrevious: ” & rs.Supports(adMovePrevious)
          
          rs.Close
          cn.Close
          
      End Sub

    读者可以自行创建测试环境运行这段代码(可根据需要做适当修改),其中程序将各种值打印到Immediate窗口中了。

  • 1 If strTableName = db.TableDefs(i).Name Then ‘Table Exists
    fExistTable = True Exit For End If Next i Set db = NothingEnd Function

Private Sub mnuCut_Click()
Clipboard.SetText RichTextBox1.SelText, 1 ‘剪切
RichTextBox1.SelText = “”
End Sub

金沙js娱乐场官方网站 1
返回目录

经验证,可以实现需求。如果Qty0,即表示表已存在,否则就表示不存在。

Private Sub RichTextBox1_Change()
If Not trapUndo Then Exit Sub ‘因为because trapping is disabled

 Excel ADO

End Sub不再报错。仔细分析,其实是用 已知表名
通过Dao判断数据库中是否存在,如果fExistTable的值为True就是存在,否则就是不存在。

‘Redo子程序
Public Sub Redo()
Dim chg$
Dim DeleteFlag As Boolean ‘标志删除或添加文本的变量
Dim objElement As Object
If RedoStack.Count > 0 And trapUndo Then
trapUndo = False
DeleteFlag = RedoStack(RedoStack.Count).TextLen <
Len(RichTextBox1.Text)
If DeleteFlag Then ‘为真则删除
Set objElement = RedoStack(RedoStack.Count)
RichTextBox1.SelStart = objElement.SelStart
RichTextBox1.SelLength = Len(RichTextBox1.Text) – objElement.TextLen
RichTextBox1.SelText = “”
Else ‘反之则添加
Set objElement = RedoStack(RedoStack.Count)
chg$ = Change(RichTextBox1.Text, objElement.Text, objElement.SelStart +
1)
RichTextBox1.SelStart = objElement.SelStart – Len(chg$)
RichTextBox1.SelLength = 0
RichTextBox1.SelText = chg$
RichTextBox1.SelStart = objElement.SelStart – Len(chg$)
If Len(chg$) > 1 And chg$ <> vbCrLf Then
RichTextBox1.SelLength = Len(chg$)
Else
RichTextBox1.SelStart = RichTextBox1.SelStart + Len(chg$)
End If
End If
UndoStack.Add Item:=objElement
RedoStack.Remove RedoStack.Count
End If
EnableControls
trapUndo = True
RichTextBox1.SetFocus
End Sub

    1. 导入XML文件到Excel的一个例子
      Sub OpenAdoFile() 
          Dim myRecordset As ADODB.Recordset 
          Dim objExcel As Excel.Application 
          Dim myWorkbook As Excel.Workbook 
          Dim myWorksheet As Excel.Worksheet 
          Dim StartRange As Excel.Range 
          Dim h as Integer 

        Set myRecordset = New ADODB.Recordset 

        myRecordset.Open “C:\data.xml”, “Provider=MSPersist” 

        Set objExcel = New Excel.Application 
        Set myWorkbook = objExcel.Workbooks.Add 
        Set myWorksheet = myWorkbook.ActiveSheet 
        objExcel.Visible = True 
            For h = 1 To myRecordset.Fields.Count 
                myWorksheet.Cells(1, h).Value = myRecordset.Fields(h – 1).Name 
            Next 
        Set StartRange = myWorksheet.Cells(2, 1) 
        StartRange.CopyFromRecordset myRecordset 
        myWorksheet.Range(“A1”).CurrentRegion.Select 
        myWorksheet.Columns.AutoFit 
        myWorkbook.SaveAs “C:\ExcelReport.xls” 

        Set objExcel = Nothing 
        Set myRecordset = Nothing 
    End Sub

解决问题后,忽然想起Access数据库也有系统表,存放有对象名,是否做一查询来判定呢

是不是很容易?不过,想要无限地undo下次,就不那么简单了。土人曾拟编写一个,却无意中发现了Bart
Lorang,一个年仅十多岁的美国小子已经在网上公开了类似的代码。这家伙敢跟老盖叫劲儿,号称”Not
the next Bill Gates, but the first Bart
Lorang”,好大的口气!不过他的程序确实不错,现特意将其内容拿出来给大家瞧瞧。为了适用于中文环境,土人对源码作了些微改动。注意:不仅可以undo,还可以redo哟!
(如果你用此代码于你编制的记事本,Bart
Lorang要求给他发一个拷贝:BartLorang@POBoxes.com)

金沙js娱乐场官方网站 2
返回目录

注释:以下代码为通常的引用Dao做的一模块

‘请给窗体添加按钮两个、RichTextBox一个,取默认值;
‘菜单若干:——
‘层次 Name属性 Caption属性
‘ 1 Edit 编辑
‘ 2 mnuUndo 撤销
‘ 2 mnuRedo 恢复
‘ 2 mnuCut 剪切
‘ 2 mnuCopy 复制
‘ 2 mnuPaste 粘贴
‘ 2 mnuDelete 删除
‘ 2 mnuSelectAll 全选

金沙js娱乐场官方网站 3
Column
金沙js娱乐场官方网站 3
ComboBox
金沙js娱乐场官方网站 3 Copy
Paste
金沙js娱乐场官方网站 3
CountA
金沙js娱乐场官方网站 3
Evaluate
金沙js娱乐场官方网站 3 Excel to
XML
金沙js娱乐场官方网站 3 Excel
ADO
金沙js娱乐场官方网站 3 Excel to Text
File
金沙js娱乐场官方网站 3 Excel
Toolbar

Function fExistTable(strTableName As String) As IntegerDim db As
DatabaseDim i As Integer Set db = DBEngine.Workspaces(0).Databases(0)
fExistTable = False db.TableDefs.Refresh For i = 0 To db.TableDefs.Count

生活中的What’s done cannot be undone在我们的程序中应该改为What’s done
can always be undone。你不相信?那么请看——
如果仅仅象MS的小记事本那样只有一次undo功能,那不是一件麻烦事,用SendMessage函数就可以轻松实现。下列代码能使RichTextBox有一次撤销操作的功能:

 ComboBox

怎样用SQL语句来判断已知表是否存在

Private Sub mnuRedo_Click()
Command2_Click
End Sub

金沙js娱乐场官方网站 12
返回目录

用该事件出现参数不可选的错误。仔细研究,发现fExistTable缺少参数,即已知表名没有在代码中反应。

Private Sub Form_Load()
RichTextBox1.Text = “”
Command1.Caption = “撤销”
Command2.Caption = “恢复”
trapUndo = True
RichTextBox1_Change
RichTextBox1_SelChange
Show
DoEvents
End Sub

金沙js娱乐场官方网站 13
返回目录

答:具体解决方法如下:

Public SelStart As Long ‘文本框中的开始位置
Public TextLen As Long ‘文本长度
Public Text As String ‘文本内容

 Excel Toolbar

修改为:

‘ ****** 窗体代码:

 CountA

Private Sub 命令0_Click()fExistTableEnd Sub

Private trapUndo As Boolean
Private UndoStack As New Collection ‘可撤销的集合
Private RedoStack As New Collection ‘可恢复的集合

    1. 使用TextToColumns方法 
      Private Sub CommandButton1_Click()
          Dim rg As Range
          Set rg = ThisWorkbook.Worksheets(“Sheet3”).Range(“a20”).CurrentRegion
          CSVTextToColumns rg, rg.Offset(0, 2)
          ‘CSVTextToColumns rg
          Set rg = Nothing
      End Sub

    Sub CSVTextToColumns(rg As Range, Optional rgDestination As Range)
        If IsMissing(rgDestination) Or rgDestination Is Nothing Then
            rg.TextToColumns , xlDelimited, , , , , True
        Else
            rg.TextToColumns rgDestination, xlDelimited, , , , , True
        End If
    End Sub

    Range.TextToColumns方法用于将包含文本的一列单元格分解为若干列,有关该方法的详细介绍,读者可以参考Excel的帮助信息,在Excel的帮助信息中搜索TextToColumns即可。示例中的代码将Sheet3中A20单元格所在的当前区域(可以简单地理解为A1:A20的区域)的内容通过TextToColumns方法复制到第三列中,这个由Offset的值决定。如果要演示该示例,读者可以在Excel中创建一个名称为Sheet3的工作表,然后在A1至A20的单元格中输入值,复制代码到Excel
    VBA工程中,通过按钮触发Click事件。

    1. 导出Range中的数据到文本文件
      Sub ExportRange()
          FirstCol = 1
          LastCol = 3
          FirstRow = 1
          LastRow = 3
          
          Open ThisWorkbook.Path & “\textfile.txt” For Output As #1
              For r = FirstRow To LastRow
                  For c = FirstCol To LastCol
                      Dim vData As Variant
                      vData = Cells(r, c).value
                      If IsNumeric(vData) Then vData = Val(vData)
                      If c <> LastCol Then
                          Write #1, vData;
                      Else
                          Write #1, vData
                      End If
                  Next c
              Next r
          Close #1
      End Sub
    1. 从文本文件导入数据到Excel
      Private Sub CommandButton1_Click()
          Set ImpRng = ActiveCell
          Open “c:\textfile.txt” For Input As #1
          txt = “”
          Application.ScreenUpdating = False
          Do While Not EOF(1)
              Line Input #1, vData
              ImpRng.Value = vData
              Set ImpRng = ImpRng.Offset(1, 0)
          Loop
          Close #1
          Application.ScreenUpdating = True
      End Sub

    示例从c:\textfile.txt文件中按行读取数据并依次显示到当前Sheet的单元格中。