QUERY ACCESS DATABASE (*.MDB) WITH VBSCRIPT

VBSCRIPT TO EXECUTE AN ACTION QUERY OR QUERIES IN A JET (*.MDB) DATABASE

Function vmkCommand(SQL, MDB)
	On Error Resume Next

	Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
	If (FSO Is Nothing) Then
		Msgbox "ACTIVEX COMPONENT CAN'T CREATE OBJECT" & vbcrlf & vbcrlf & "SCRIPTING.FILESYSTEMOBJECT",,VersionMin
		vmkCommand = False
		Exit Function
	End If

	If FSO.FileExists(MDB) Then
		Dim OJET : Set OJET = CreateObject("DAO.DBEngine.36")
		If (OJET Is Nothing) Then
			Msgbox "ACTIVEX COMPONENT CAN'T CREATE OBJECT" & vbcrlf & vbcrlf & "DAO.DBENGINE.36",,VersionMin
			vmkCommand = False
			Exit Function
		End If

		Dim ODB : Set ODB = OJET.OpenDatabase(MDB)
		If (ODB Is Nothing) Then
			Msgbox "COULD NOT OPEN THE DATABASE  " & chr(34) & UCase(FSO.GetFileName(MDB)) & chr(34),,VersionMin
			vmkCommand = False
			Exit Function
		End If

		If Len(SQL) < 6 Then
			Msgbox "YOUR SQL IS NOT VALID",,VersionMin
			vmkCommand = False
			Exit Function
		End If

		Dim Command : Command = UCase(Mid(SQL,1,6))
		Select Case Command
			Case "SELECT"
				Dim RST : Set RST = ODB.OpenRecordset(SQL)
				If (Err.Number > 0) Then
					vmkCommand = UCase(Err.Description)
				Else
					If Not(RST.EOF And RST.BOF) Then

						Dim TTCols, TTColsTMP : TTCols = 0
						Do While 1
							TTColsTMP = RST(TTCols)
							If Err.Number > 0 Then TTCols = TTCols - 1 : Exit Do
							TTCols = TTCols + 1
						Loop

						Dim IRow : IRow = 0
						Dim Rows(), Cols()

						RST.MoveFirst
						Do While Not RST.EOF

							ReDim Cols(TTCols)
							Dim I : I = 0
							For I = 0 To TTCols
								Cols(I) = RST(I)
							Next

							ReDim Preserve Rows(IRow)
							Rows(IRow) = Cols
							IRow = IRow + 1

							RST.MoveNext
						Loop
						vmkCommand = Rows
					Else
						vmkCommand = ""
					End If
				End If
				RST.Close
				Set RST = Nothing
				Exit Function
			Case "INSERT", "DELETE", "UPDATE"
				ODB.Execute SQL, 128
				If (Err.Number > 0) Then
					vmkCommand = UCase(Err.Description)
				Else
					vmkCommand = True
				End If
				Exit Function
			Case Else
				Msgbox "YOUR SQL IS NOT VALID",,VersionMin
				vmkCommand = False
				Exit Function
		End Select

		ODB.Close
		Set ODB = Nothing
		Set OJET = Nothing
		vmkCommand = True
	Else
		Msgbox UCase(FSO.GetFileName(MDB)) & "  IS  MISSING",,VersionMin
		vmkCommand = False
	End If
End Function

Function IsArrayDimmed(Arr)
	IsArrayDimmed = False
	If IsArray(Arr) Then
		On Error Resume Next
		Dim UB : UB = UBound(Arr)
		If (Err.Number = 0) And (UB >= 0) Then IsArrayDimmed = True
	End If
End Function

''' TEST '''

Dim Query
Query = vmkCommand("SELECT * FROM USER", "C:\USER.MDB")
If IsArrayDimmed(Query) Then
	Dim I
	For I = 0 To UBound(Query)
		If IsArrayDimmed(Query(I)) Then
			Dim I1
			For I1 = 0 To UBound(Query(I))
				Msgbox Query(I)(I1)
			Next
		End If
	Next
Else
	Msgbox Query
End If

Query = vmkCommand("DELETE * FROM USER", "C:\USER.MDB")
Msgbox Query

Query = vmkCommand("INSERT INTO USER([ID],[PASS]) VALUES(1,888);", "C:\USER.MDB")
Msgbox Query

Query = vmkCommand("UPDATE USER SET [PASS]=999 WHERE [ID]=1", "C:\USER.MDB")
Msgbox Query