MS-SQL Server utilities Enterprise Manager and Query Analyzer will model
almost any MS-SQL object as a simple script file with a default ".sql"
extension.
But how to "run these files? They are in a slightly modifies character set
and contain commands only usable by the Server's SQL utilities. If one
tries to use them on a machine which does not have the SQL utilities
installed, one seems to have a laborious cut-and-paste task.
(Of course, if Access has a simple and better way, I hope you will let me
know.)
I have written a tiny bit of utility code that
allows one to select such an sql file,
decodes and parses the script
and allows one to Execute or not Execute its various parts.
You can find it at
http://ffdba.com/downloads
but I think it is small enough to post here:
'Don't mess with this unless you are experienced and capable.
'Back up your database before using.
Option Explicit
Option Base 0
Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
Private Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_SHAREAWARE = &H4000
Private Const MAX_PATH = 260
Private Const DELIMITER = vbNewLine & "GO" & vbNewLine
Private Sub FindAndExecuteSQLScript()
Dim Script As String
Dim FullPathToFile As String
FindSQLScript Script, FullPathToFile
Debug.Print Script
If MsgBox( _
"Execute " _
& vbNewLine _
& vbNewLine _
& FullPathToFile & "?" _
& vbNewLine _
& vbNewLine _
& "Are you SURE?" _
& vbNewLine _
& vbNewLine _
& "If you're not sure, choose No," _
& vbNewLine _
& "and examine the immediate window" _
& vbNewLine _
& "where the Script has been copied.", _
vbQuestion Or vbYesNo, _
"This Procedure Can Cause Significant Damage To Your
Database.") _
= vbYes Then
ExecuteSQLScript Script
End If
End Sub
Private Sub ExecuteSQLScript( _
ByVal Script As String)
Dim aSubScripts() As String
Dim SubScript As String
Dim z As Long
aSubScripts = Split(Script, DELIMITER)
For z = 0 To UBound(aSubScripts)
aSubScripts(z) = Trim$(aSubScripts(z))
SubScript = aSubScripts(z)
If Len(SubScript) > 255 Then
SubScript = Left$(aSubScripts(z), InStr(255, aSubScripts(z),
vbNewLine))
End If
If Len(Replace(SubScript, vbNewLine, "")) > 1 Then
If Left$(SubScript, 3) <> "SET" Then
If MsgBox("EXECUTE " & vbNewLine & SubScript, vbQuestion Or
vbYesNo, "FFDBA") = vbYes Then
CurrentProject.Connection.Execute aSubScripts(z)
End If
End If
End If
Next z
End Sub
Private Sub FindSQLScript( _
ByRef Script As String, _
ByRef FullPathToFile As String, _
Optional ByVal Owner As String, _
Optional ByVal ChatPartner As String)
Dim EntireMessage As String
Dim FileNumber As Integer
' get full path to file
If Len(FullPathToFile) = 0 Then
FullPathToFile = GetFile()
End If
' get entire message
FileNumber = FreeFile()
Script = String(FileLen(FullPathToFile), vbNullChar)
Open FullPathToFile For Binary As #FileNumber
Get #FileNumber, , Script
Close #FileNumber
Script = Mid$(StrConv(Script, vbFromUnicode), 2)
FindSQLScriptExit:
Close
Exit Sub
FindSQLScriptErr:
With Err
MsgBox .Description, , "Error " & .Number
End With
Resume FindSQLScriptExit
End Sub
Private Function GetFile(Optional InitialDir As String, _
Optional FilterMessage As String = "MS-SQL Scrips", _
Optional FilterSkelton As String = "*.sql", _
Optional File As String = "*.sql", _
Optional Title As String = "Use the Open Button to Select") As String
GetFile = GetPath(InitialDir, FilterMessage, FilterSkelton, File,
Title)
End Function
Private Function GetPath( _
Optional InitialDir As String, _
Optional FilterMessage As String = "Choose Folder Only", _
Optional FilterSkelton As String = "*|*", _
Optional File As String = "Folders Only", _
Optional Title As String = "Use the Open Button to Select") As String
Dim CommDlgError As Long
Dim OFN As OPENFILENAME
If Len(InitialDir) = 0 Then InitialDir = CurDir$()
With OFN
.lStructSize = Len(OFN)
.lpstrFilter = FilterMessage & vbNullChar & FilterSkelton & String
(2, vbNullChar)
.lpstrFile = File & String(MAX_PATH - Len(File), vbNullChar)
.nMaxFile = MAX_PATH
.lpstrInitialDir = InitialDir & vbNullChar
.lpstrTitle = Title
.flags = OFN_HIDEREADONLY Or OFN_NOCHANGEDIR Or OFN_SHAREAWARE
If GetOpenFileName(OFN) <> 0 Then
If FilterSkelton = "*|*" Then
GetPath = Left$(.lpstrFile, .nFileOffset)
Else
GetPath = .lpstrFile
End If
GetPath = Left$(GetPath, InStr(GetPath, vbNullChar) - 1)
Else
CommDlgError = CommDlgExtendedError
' if not just a cancel
If CommDlgError <> 0 Then
MsgBox "Common Dialog Error # " & CommDlgError _
& vbCrLf _
& vbCrLf _
& "Consult Common Dialog Documumentation" _
& vbCrLf _
& "(in MSDN Library)" _
& vbCrLf _
& vbCrLf _
& "for meaning.", _
vbCritical, _
"FFDBA"
End If
End If
End With
End Function
--
Lyle
(for e-mail refer to http://ffdba.com/contacts.htm)
