This is a page dedicated to all flavors of VB, VBA & VBA Script. I have been working with macros for decades (since Excel 4.0. etc). My main foray into programming began with Word Templates.

VBA Snippets

  • ASP
    • MySQL Connection
      • <%

        Dim sConnection
        Dim oConnection

        Dim oRS

        sConnection = "DRIVER={MySQL ODBC 3.51 Driver}; SERVER=website.com;
        DATABASE= DBNAMEHERE;UID=LOGIN;PASSWORD=PASSWORD; OPTION=3"

        Set oConnection = Server.CreateObject("ADODB.Connection")

        oConnection.Open(sConnection)

        Set oRS = oConnection.Execute("SELECT * FROM TABLENAME")

        While Not oRS.EOF
        Response.Write oRS("FIELDNAME1HERE") & vbTab & oRS("FIELDNAME2HERE") & ("
        ")
        oRS.MoveNext

        oRS.Close
        Set oRS = Nothing

        oConnection.Close
        Set oConnection = Nothing
        %>

    • Drop Down List Example
  • If Statement
      Dim Number, MyText, LenTxt, A
      While Len(MyText) <> 1
        MyText = InputBox("Type one character below." & LenTxt, "MCNet Input Box Example")
        'If IsEmpty(MyText) Then Exit Sub '****Input Box CANCEL function - VBSCRIPT VERSION ****
        If StrPtr(MyText) = 0 Then Exit Sub '***Input Box CANCEL function - VB VERSION ***
        LenTxt = Chr(13) & "Please only use one Character.
      Wend

      If IsNumeric(MyText) = True Then
        MsgBox MyText & " is a Number."
      Else

      For A = 65 To 90 'Runs through all Upper Case Letters
        If MyText = Chr(A) Then
          MsgBox MyText & " is an Upper Case Letter."
          Exit For
        End If
      Next
      End If

      If A = 91 Then 'If 'a' = 91 then it is not Upper Case
      For A = 97 To 122 'Runs through all Lower Case Letters
        If MyText = Chr(A) Then
          MsgBox MyText & " is a Lower Case Letter."
          Exit For
        End If
      Next
      End If

      If A = 123 Then MsgBox MyText & " is Not a Number, Upper or Lower Case Letter."
      End If
  • Functions
      Sub GetLastName
      MyVal = ValToRight("Matthew Collins", Chr(32))
      Msgbox MyVal 'Should be "Collins"
      End Sub

      Function ValFromLeft(MyFileName, LookingFor)
      '*** ValFromLeft is Value from the Left of the LAST Instance ***

      RSpacer = InStrRev(MyFileName, LookingFor) 'searches for "\"
      MyFileName = Left(MyFileName, RSpacer)

      ValFromLeft = MyFileName
      End Function

      Function ValToRight(MyFileName, LookingFor)
      '*** ValToRight is Value to the Right of the LAST Instance ***

      RSpacer = InStrRev(MyFileName, LookingFor) 'searches for "\"
      MyFileName = Right(MyFileName, Len(MyFileName) - RSpacer)

      ValToRight = MyFileName
      End Function
  • Select Case
      Answer = MsgBox("Clicking yes will get a Yes Dialog Box." & Chr(13) & Chr(10) & _
      " Clicking 'No' will get a No Dialog Box" & Chr(13) & Chr(10) & _
      " Click to continue.", 259)

      Select Case Answer
      Case 6 'Choose Yes
      MyMsg= "Yes"
      Case 7 'Choose No
      MyMsg= "No"
      End Select

      Msgbox MyMsg
  • Office Tricks
    • Word
    • Excel
      • ActiveCell.Offset(1, 0).Range("A1").Select
      • XLS to XML