VB Code
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.
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
%>
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
Click Here
{cke_protected}{C}%3C!%2D%2D***************************************************************%2D%2D%3E
If Statement
Dim Number, MyText, LenTxt, A
While Len(MyText) <> 1
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.
'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
If IsNumeric(MyText) = True Then
MsgBox MyText & " is a Number."
Else
For A = 65 To 90 'Runs through all Upper Case Letters
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
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
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
Exit For
End If
Next
End If
If A = 123 Then MsgBox MyText & " is Not a Number, Upper or Lower Case Letter."
End If
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"
Msgbox MyVal 'Should be "Collins"
End Sub
Function ValFromLeft(MyFileName, LookingFor)
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
RSpacer = InStrRev(MyFileName, LookingFor) 'searches for "\"
MyFileName = Left(MyFileName, RSpacer)
ValFromLeft = MyFileName
End Function
Function ValToRight(MyFileName, LookingFor)
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
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
{cke_protected}{C}%3C!%2D%2D***************************************************************%2D%2D%3E
Office Tricks
Word
Excel
ActiveCell.Offset(1, 0).Range("A1").Select
XLS to XML
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
{cke_protected}{C}%3C!%2D%2D***************************************************************%2D%2D%3E
Office Tricks
Word
Excel
ActiveCell.Offset(1, 0).Range("A1").Select
XLS to XML