I cannot get it to work in VBA - Excel. I use the same header and XML-body in Postman - fine! Good response. I need to use a client certificate to identify myself, but I cannot get it done in VBA. The code needs to post some data (the XMLPostMessage) and then it receives some data from the server (a XML message as well).
The response I get from the server is a message in XML that has something to do with "Unidentified user". So, I do have communication, but it is not recognised as 'from a trusted party'. But using this certificate in Postman does give a good response.
== My VBA code: ==
Public Sub server()
Dim O As New ServerXMLHTTP60
Dim xmlDoc As New MSXML2.DOMDocument60
Dim XMLPostMessage As String
XMLPostMessage = "<WEB-UAS-AANVR>" & _
"<ALG-GEG>" & _
"<PROC-IDENT>3637</PROC-IDENT>" & _
"<PROC-FUNC>1</PROC-FUNC>" & _
"<INFO-GEBR>DITISEENTEST</INFO-GEBR>" & _
"</ALG-GEG>" & _
"<WEB-UAS-GEG>" & _
"<UAS-VRR-EXAMEN-GEG>" & _
"<UAS-VRR-EX-INST></UAS-VRR-EX-INST>" & _
"<UAS-VRR-EX-SRT>A2</UAS-VRR-EX-SRT>" & _
"<UAS-VRR-EX-DAT>20211210</UAS-VRR-EX-DAT>" & _
"<GEB-DAT-UAS-VRR>19840726</GEB-DAT-UAS-VRR>" & _
"<UAS-VRR-EX-REF>#12345</UAS-VRR-EX-REF>" & _
"</UAS-VRR-EXAMEN-GEG>" & _
"</WEB-UAS-GEG>" & _
"</WEB-UAS-AANVR>"
With O
.Open "POST", "https://<the serverpath goes here>", False
.setRequestHeader "Content-type", "application/xml"
.setRequestHeader "Content-type", "text/xml"
.setRequestHeader "Charset", "UTF-8"
.setOption 3, "<The Friendly Name of the certificate goes here>"
' .setOption 3, "CURRENT_USER\My\<The Friendly Name of the certificate goes here>"
.send XMLPostMessage
xmlDoc.LoadXML (O.responseXML.XML)
Debug.Print xmlDoc.XML
If Not .Status = 200 Then
MsgBox "UnAuthorized. Message: " & .Status & " - " & .statusText
Exit Sub
End If
End With
Set O = Nothing
End Sub
I am extremely new to Visual Basic
I am currently trying to create a calculator within excel that I can export the data within to a PDF. I have been able to export the excel document however it is only going to my "D:\".
How do I create a folder within D:\ called something like Excel_Calculator where I can have all the PDF's created be saved directly into that folder & If there already is a folder called "Excel_Calculator" to use that folder instead of overwriting the existing folder.
The code I have for saving the PDF is listed here:
Sub GetFilenameForPDF()
Dim strFileName As String, strB1 As String, strWorksheet As String
strB1 = Range("B1").Value
strWorksheet = ActiveSheet.Name
strFileName = strB1 & " " & strWorksheet & " " & Format(Date, "DD-MM-YYYY")
Sub SaveToPDF()
Dim strFileName As String, strC3 As String, strWorksheet As String
strB1 = Range("B1").Value
strWorksheet = ActiveSheet.Name
strFileName = strB1 & " " & strWorksheet & " " & Format(Date, "DD-MM-YYYY")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"D:\" & strFileName & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
End Sub
** EDIT: Or is there a way I can create or redirect the files to a temporary location so that the folder isn't clogged up and the user can print/save the PDF when needed?**
I prefer using the FileSystemObject
In your VBA project, click Toos->References and add "Microsoft Scripting Runtime".
Then, in your code, do something like:
Dim fso as FileSystemObject
Dim folderName as String
Set fso = new FileSystemObject
folderName = "D:\MyFolder"
If fso.FolderExists(folderName) = false then
fso.CreateFolder folderName
End If
Dim strFileName As String, strC3 As String, strWorksheet As String
strB1 = Range("B1").Value
strWorksheet = ActiveSheet.Name
strFileName = folderName + "\" + strB1 & " " & strWorksheet & " " & Format(Date, "DD-MM-YYYY")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"D:\" & strFileName & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
You can use the function below to create a single folder or a tree of subfolders. The function uses the (VBA.FileSystem) MkDir function.
Public Function CreateFolderTree(ByVal mainFolder As String, ParamArray args() As Variant) As String
On Error GoTo ErrProc
Dim path As String
path = mainFolder & IIf(Right(mainFolder, 1) <> "\", "\", vbNullString)
Dim idx As Long
For idx = LBound(args) To UBound(args)
If Len(Dir(path & args(idx), vbDirectory)) = 0 Then MkDir path & args(idx)
path = path & args(idx) & "\"
Next idx
CreateFolderTree = path
Leave:
On Error GoTo 0
Exit Function
ErrProc:
MsgBox Err.Description, vbCritical
Resume Leave
End Function
To call it:
Sub T()
Dim path_ As String
path_ = CreateFolderTree("C:\My folder", "Subfolder 1", "Subfolder 2")
Debug.Print path_
'C:\My folder\Subfolder 1\Subfolder 2\
End Sub
I usually use this:
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
Public Sub MakeFullDir(strPath As String)
If Right(strPath, 1) <> "\" Then strPath = strPath & "\" 'Optional depending upon intent
MakeSureDirectoryPathExists strPath
End Sub
If the path doesn't already exists, it creates it, even if there are multiple layer of non-existing folders.
E.g: C:\aFolder\bFolder\cFolder\ if only aFolder exists this will make bFolder and cFolder.
I've got a problem implementing ReCaptcha from google in classic asp.
The Captcha displays well below my form, but when I submit the form, it's always accepted even if the captcha fields are left empty or are wrong.
Here's the code I use in my first "form" page.
Right at the top of the page I've this :
<%
recaptcha_challenge_field = Request("recaptcha_challenge_field")
recaptcha_response_field = Request("recaptcha_response_field")
recaptcha_public_key = "mykeyofcourse" ' your public key
recaptcha_private_key = "and here the private one" ' your private key
' returns the HTML for the widget
function recaptcha_challenge_writer()
recaptcha_challenge_writer = _
"<script type=""text/javascript"">" & _
"var RecaptchaOptions = {" & _
" theme : 'red'," & _
" tabindex : 0" & _
"};" & _
"</script>" & _
"<script type=""text/javascript"" src=""http://www.google.com/recaptcha/api/challenge?k=" & recaptcha_public_key & """></script>" & _
"<noscript>" & _
"<iframe src=""http://www.google.com/recaptcha/api/noscript?k=" & recaptcha_public_key & """ frameborder=""1""></iframe><>" & _
"<textarea name=""recaptcha_challenge_field"" rows=""3"" cols=""40""></textarea>" & _
"<input type=""hidden"" name=""recaptcha_response_field""value=""manual_challenge"">" & _
""
end function
' returns "" if correct, otherwise it returns the error response
function recaptcha_confirm(rechallenge,reresponse)
Dim VarString
VarString = _
"privatekey=" & recaptcha_private_key & _
"&remoteip=" & Request.ServerVariables("REMOTE_ADDR") & _
"&challenge=" & rechallenge & _
"&response=" & reresponse
Dim objXmlHttp
Set objXmlHttp = Server.CreateObject("Msxml2.ServerXMLHTTP")
objXmlHttp.open "POST", "https://www.google.com/recaptcha/api/verify", False
objXmlHttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objXmlHttp.send VarString
Dim ResponseString
ResponseString = split(objXmlHttp.responseText, vblf)
Set objXmlHttp = Nothing
if ResponseString(0) = "true" then
'They answered correctly
recaptcha_confirm = ""
else
'They answered incorrectly
recaptcha_confirm = ResponseString(1)
end if
end function
server_response = ""
newCaptcha = True
if (recaptcha_challenge_field <> "" or recaptcha_response_field <> "") then
server_response = recaptcha_confirm(recaptcha_challenge_field, recaptcha_response_field)
newCaptcha = False
end if
%>
in my form, above the submit button I have this code :
<%=recaptcha_challenge_writer()%>
Now to the ASP page that checks the form.
On the top of the page I have this :
if server_response <> "" or newCaptcha then
Erreur="oui"
else
Erreur="non"
end if
response.write "erreur : "&erreur
But...erreur is always = non whatever the value of the captcha field is.
Any idea what I'm doing wrong
Thanks in advance
I've got code in a project to read data from a Sheet into a recordset. The VBA code is password protected.
For testing I simplified the code, as shown below:
Option Explicit
Sub sTest()
Dim dbtmp As DAO.Database
Set dbtmp = OpenDatabase(Application.ActiveWorkbook.FullName, False, True, _
"Excel 8.0;HDR=Yes")
dbtmp.Close
Set dbtmp = Nothing
End Sub
Whenever I run this code from a Userform, after closing excel, I get prompted for the VBAProject password. Depending on the, I guess, number of modules in the workbook, I've got to cancel, at least, twice.
I've been breaking my head over this for the last week, read every post on the net I could find, but didn't find a solution yet.
As stated by Miqi180, this issue occurs when references to the workbook are not properly cleared; see Microsoft Knowledge Database
It could also occur when Office AddIns are installed.
There were/are some known issues:
Acrobat PDFMaker COM Addin
Fixed in Acrobat 11.0.1
Dropbox
Not yet fixed; workaround
Other Addin?
Uncheck 'OLE Automation' in the References window:
I have experienced the same problem in an Outlook project which opens an Excel file, so contrary to what others have speculated, it is not directly related to database (ADO or DAO) technology.
From the Microsoft Knowledge Database:
SYMPTOMS
After running a macro that passes a reference for a workbook
containing a password-protected VBA project to an ActiveX dynamic-link
library (DLL), you are prompted for the VBA project password when
Excel quits.
CAUSE
This problem occurs if the ActiveX DLL does not properly release
the reference to the workbook that contains the password-protected VBA
project.
The problem typically occurs when a circular reference between objects exists and the password prompt appears if the objects hold onto a reference for a protected workbook when Excel is closed.
Example: objectA stores a reference to objectB, and objectB stores a reference to objectA. The two objects are not destroyed unless you explicitly set objectA.ReferenceToB = Nothing or objectB.ReferenceToA = Nothing.
As I cannot replicate the symptoms by running your code on my computer, my guess is that you have modified your code for Stackoverflow in a way that removes the problem, e.g. by redefining public variables within the scope of the procedure.
This is a problem that has intermittently plagued my own Excel VBA add-ins for a small number of customers. I've documented the problem in my online documentation: VB Password Prompt.
While working on a specific situation for a client, I came up with a solution. I don't know if it only works for his situation (on just my machine) or if it is more widely applicable.
Insert the line "ThisWorkbook.Saved = True" at the end of the Workbook_BeforeClose event:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
' blah blah before close code
ThisWorkbook.Saved = True
End Sub
If anyone has a chance to try this, could you let me know if it helps for you and/or your clients.
DAO isn't a great platform for reading data out of Excel files.
Actually, none of the available Microsoft database driver technologies are - they've all got some memory leaks, and the older ones create a hidden instance of Excel.exe - so anything in the VBA project (like, for example, a missing library or an event that calls noncompiling code) will raise the kind of errors that would make Excel think you are attempting to access the code.
Here's some code that uses ADODB, a more recent database technology that may work around any specific problems with DAO.
I haven't had time to strip out all the stuff that's irrelevant to your request - apologies, there's a lot of it! - but leaving in all those alternative connection strings is probably quite helpful for you: anyone who gets this kind of problem needs to need to play around a little, and work out which technology works by trial and error:
Public Function FetchRecordsetFromWorkbook(ByVal SourceFile As String, _
ByVal SourceRange As String, _
Optional ReadHeaders As Boolean = True, _
Optional StatusMessage As String = "", _
Optional GetSchema As Boolean = False, _
Optional CacheFile As String = "" _
) As ADODB.Recordset
Application.Volatile False
' Returns a static persistent non-locking ADODB recordset from a range in a workbook
' If your range is a worksheet, append "$" to the worksheet name. A list of the 'table'
' names available in the workbook can be extracted by setting parameter GetSchema=True
' If you set ReadHeaders = True the first row of your data will be treated as the field
' names of a table; this means that you can pass a SQL query instead of a range or table
' If you set ReadHeaders = False, the first row of your data will be treatd as data; the
' column names will be allocated automatically as 'F1', 'F2'...
' StatusMessage returns the rowcount if retrieval proceeds without errors, or '#ERROR'
' Be warned, the Microsoft ACE database drivers have memory leaks and stability issues
On Error GoTo ErrSub
Const TIMEOUT As Long = 60
Dim objConnect As ADODB.Connection
Dim rst As ADODB.Recordset
Dim strConnect As String
Dim bFileIsOpen As Boolean
Dim objFSO As Scripting.FileSystemObject
Dim i As Long
Dim TempFile As String
Dim strTest As String
Dim SQL As String
Dim strExtension As String
Dim strPathFull As String
Dim timeStart As Single
Dim strHeaders As String
Dim strFilter As String
If SourceFile = "" Then
Exit Function
End If
' Parse out web folder paths
If Left(SourceFile, 5) = "http:" Then
SourceFile = Right(SourceFile, Len(SourceFile) - 5)
SourceFile = Replace(SourceFile, "%20", " ")
SourceFile = Replace(SourceFile, "%160", " ")
SourceFile = Replace(SourceFile, "/", "\")
End If
strPathFull = SourceFile
If Len(Dir(SourceFile)) = 0 Then
Err.Raise 1004, APP_NAME & "GetRecordsetFromWorkbook", _
"#ERROR - file '" & SourceFile & "' not found."
Exit Function
End If
Set objFSO = FSO
strExtension = GetExtension(strPathFull)
bFileIsOpen = FileIsOpen(SourceFile)
If Not bFileIsOpen Then
TempFile = objFSO.GetSpecialFolder(2).Path & "\" & TrimExtension(objFSO.GetTempName()) _
& "." & strExtension
objFSO.CopyFile SourceFile, TempFile, True
SourceFile = TempFile
End If
If InStr(1, SourceRange, "SELECT", vbTextCompare) > 0 And _
InStr(7, SourceRange, "FROM", vbTextCompare) > 1 Then
strHeaders = "HDR=Yes"
ElseIf ReadHeaders = True Then
strHeaders = "HDR=Yes"
Else
strHeaders = "HDR=No"
End If
Select Case strExtension
Case "xls"
'strConnect = "ODBC;DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
' & "ReadOnly=1;DBQ=" & Chr(34) & SourceFile & Chr(34) & ";" _
' & ";Extended Properties=" &Chr(34) & "HDR=No;IMEX=1;MaxScanRows=0" & Chr(34) & ";"
'strConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Chr(34) & SourceFile & _
' Chr(34) & ";Extended Properties=" & Chr(34) & "Excel 8.0;" & strHeaders _
' & ";IMEX=1;MaxScanRows=0" & Chr(34) & ";"
strConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Chr(34) & SourceFile & _
Chr(34) & ";Persist Security Info=True;Extended Properties=" & _
Chr(34) & "Excel 8.0;" & strHeaders & ";IMEX=1;MaxScanRows=0" & Chr(34) & ";"
Case "xlsx"
strConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Chr(34) & SourceFile & _
Chr(34) & ";Persist Security Info=True;Extended Properties=" & Chr(34) & _
"Excel 12.0 Xml;" & strHeaders & ";IMEX=1;MaxScanRows=0" & Chr(34) & ";"
Case "xlsm"
'strConnect = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
' "ReadOnly=1;DBQ=" & SourceFile & ";" & Chr(34) & SourceFile & Chr(34) & ";" & _
' ";Extended Properties=" & Chr(34) & "Excel 12.0;" & strHeaders & _
' ";IMEX=1;MaxScanRows=0" & Chr(34) & ";"
strConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Chr(34) & SourceFile & _
Chr(34) & ";Persist Security Info=True;Extended Properties=" & Chr(34) _
& "Excel 12.0 Macro;" & strHeaders & ";IMEX=1;MaxScanRows=0" & Chr(34) & ";"
Case "xlsb"
'strConnect = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & "ReadOnly=1; _
' DBQ=" & SourceFile & ";" & Chr(34) & SourceFile & Chr(34) & ";" & _
' ";Extended Properties=" & Chr(34) & "Excel 12.0;" & strHeaders & _
' ";IMEX=1;MaxScanRows=0" & Chr(34) & ";"
' This ACE driver is unstable on xlsb files... But it's more likely to return a result, if you don't mind crashes:
strConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Chr(34) & SourceFile & Chr(34) & _
";Persist Security Info=True;Extended Properties=" & Chr(34) & "Excel 12.0;" & _
strHeaders & ";IMEX=1;MaxScanRows=0" & Chr(34) & ";"
Case Else
Err.Raise 999, APP_NAME & "GetRecordsetFromWorkbook", "#ERROR - file format not known"
End Select
On Error GoTo ErrSub
'SetTypeGuessRows
timeStart = VBA.Timer
Set objConnect = New ADODB.Connection
With objConnect
.ConnectionTimeout = TIMEOUT
.CommandTimeout = TIMEOUT
.Mode = adModeRead
.ConnectionString = strConnect
.Open strConnect, , , adAsyncConnect
Do While .State > adStateOpen
If VBA.Timer > timeStart + TIMEOUT Then
Err.Raise -559038737, _
APP_NAME & " GetRecordsetFromWorkbook", _
"Timeout: the Excel data connection object did not respond in the " _
& TIMEOUT & "-second interval specified by this application."
Exit Do
End If
If .State > adStateOpen Then Sleep 100
If .State > adStateOpen Then Sleep 100
Loop
End With
Set rst = New ADODB.Recordset
timeStart = VBA.Timer
With rst
.CacheSize = 8
.PageSize = 8
.LockType = adLockReadOnly
If InStr(1, SourceRange, "SELECT", vbTextCompare) > 0 And _
InStr(7, SourceRange, "FROM", vbTextCompare) > 1 Then
SQL = SourceRange
Else
.MaxRecords = 8192
SQL = "SELECT * FROM [" & SourceRange & "] "
' Exclude empty rows from the returned data using a 'WHERE' clause.
With objConnect.OpenSchema(adSchemaColumns)
strFilter = ""
.Filter = "TABLE_NAME='" & SourceRange & "'"
If .EOF Then
.Filter = 0
.MoveFirst
End If
Do While Not .EOF
If UCase(!TABLE_NAME) = UCase(SourceRange) Then
Select Case !DATA_TYPE
Case 2, 3, 4, 5, 6, 7, adUnsignedTinyInt, adNumeric
' All the numeric types you'll see in a JET recordset from Excel
strFilter = strFilter & vbCrLf & " AND [" & !COLUMN_NAME & "] = 0 "
Case 130, 202, 203, 204, 205
' Text and binary types that pun to vbstring or byte array
strFilter = strFilter & vbCrLf & " AND [" & !COLUMN_NAME & "] = '' "
End Select
' Note that we don't try our luck with the JET Boolean data type
End If
.MoveNext
Loop
.Close
End With
If strFilter <> "" Then
strFilter = Replace(strFilter, vbCrLf & " AND [", " [", 1, 1)
strFilter = vbCrLf & "WHERE " & vbCrLf & "NOT ( " & strFilter & vbCrLf & " ) "
SQL = SQL & strFilter
End If
End If
.Open SQL, objConnect, adOpenForwardOnly, adLockReadOnly, adCmdText + adAsyncFetch
i = 0
Do While .State > 1
i = (i + 1) Mod 3
Application.StatusBar = "Retrieving data" & String(i, ".")
If VBA.Timer > timeStart + TIMEOUT Then
Err.Raise -559038737, _
APP_NAME & " Fetch data", _
"Timeout: the Excel Workbook did not return data in the " & _
TIMEOUT & "-second interval specified by this application."
Exit Do
End If
If .State > 1 Then Sleep 100 ' There's a very slight performance gain doing it this way
If .State > 1 Then Sleep 100
Loop
End With
If rst.State = 1 Then
CacheFile = objFSO.GetSpecialFolder(2).Path & "\" & TrimExtension(objFSO.GetTempName()) & ".xml"
rst.Save CacheFile, adPersistXML ' , adPersistADTG
rst.Close
End If
Set rst = Nothing
objConnect.Close
objConnect.Errors.Clear
Set objConnect = Nothing
Set rst = New ADODB.Recordset
rst.CursorLocation = adUseClient
rst.StayInSync = False
rst.Open CacheFile ', , adOpenStatic, adLockReadOnly, adCmdFile
StatusMessage = rst.RecordCount
Set FetchRecordsetFromWorkbook = rst
ExitSub:
On Error Resume Next
Set rst = Nothing
objConnect.Close
Set objConnect = Nothing
If (bFileIsOpen = False) And (FileIsOpen(SourceFile) = True) Then
For i = 1 To Application.Workbooks.Count
If Application.Workbooks(i).Name = Filename(SourceFile) Then
Application.Workbooks(i).Close False
Exit For
End If
Next i
End If
Exit Function
ErrSub:
StatusMessage = ""
StatusMessage = StatusMessage & ""
If InStr(Err.Description, "not a valid name") Then
StatusMessage = StatusMessage & "Cannot read the data from your file: "
StatusMessage = StatusMessage & vbCrLf & vbCrLf
StatusMessage = StatusMessage & Err.Description
StatusMessage = StatusMessage & vbCrLf & vbCrLf
StatusMessage = StatusMessage & "It's possible that the file has been locked, _
but the most likely explanation is that the file _
doesn't contain the named sheet or range you're _
trying to read: check that you've saved the _
correct range name with the correct file name."
StatusMessage = StatusMessage & vbCrLf & vbCrLf
StatusMessage = StatusMessage & "If this error persists, please contact the Support team."
MsgBox StatusMessage, vbCritical, APP_NAME & ": data access error:"
StatusMessage = "#ERROR " & StatusMessage
ElseIf InStr(Err.Description, "Could not find the object '& SourceRange") Then
StatusMessage = StatusMessage & ""
StatusMessage = StatusMessage & ""
StatusMessage = StatusMessage & ""
MsgBox Err.Description & vbCrLf & vbCrLf & "Please contact the Support team. _
This error probably means that source _
file is locked, or that the wrong file _
has been saved here: " & vbCrLf & vbCrLf & _
strPathFull, vbCritical, APP_NAME & ": file data error:"
StatusMessage = "#ERROR " & StatusMessage
ElseIf InStr(Err.Description, "Permission Denied") Then
StatusMessage = StatusMessage & "Cannot open the file: "
StatusMessage = StatusMessage & vbCrLf & vbCrLf
StatusMessage = StatusMessage & vbTab & Chr(34) & strPathFull & Chr(34)
StatusMessage = StatusMessage & vbCrLf & vbCrLf
StatusMessage = StatusMessage & "Another user probably has this file open. _
Please wait a few minutes, and try again. _
If this error persists, please contact Desktop team."
MsgBox StatusMessage, vbCritical, APP_NAME & ": file access error:"
StatusMessage = "#ERROR " & StatusMessage
Else
StatusMessage = StatusMessage & "#ERROR " & Err.Number & ": " & Err.Description
MsgBox StatusMessage, vbCritical, APP_NAME & ": file data error:"
End If
Resume ExitSub
' # leave this inaccessible statement in place for debugging:
Resume
End Function
Apologies if you run into problems with line breaks around the '_' split lines.
You'll also need declarations for the Constant 'APP_NAME':
PUBLIC CONST APP_NAME As String = "SQL Bluescreen demonstrator"
And a VBA API declaration for the 'Sleep' function:
#If VBA7 And Win64 Then ' 64 bit Excel under 64-bit windows: PtrSafe declarations and LongLong
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongLong)
#ElseIf VBA7 Then ' VBA7 in a 32-bit environment: PtrSafe declarations, but no LongLong
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else ' 32 bit Excel
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
Running SQL against Microsoft Excel is best regarded as A Bad Thing: yes, SQL is by far the best tool for large volumes of tabulated data; but no, Microsoft aren't going to fix those memory leaks any time soon. No-one in Redmond is interested in what you are trying to do there - not when you could buy a copy of MS-Access or SQL server andport your data over.
However, it's still the least-worst solution when you're not going to get a SQL Server of your own and you've got a large volume of data in someone else's spreadsheet. Or spreadsheets, plural.
So here's a Horrible Hack to read Excel with SQL.
The subheading to that article reads:
A Cautionary Tale of things that no developer should ever see or do, with diversions and digressions into failures of business logic, workarounds and worse-arounds, budget fairies, business analysts, and scrofulous pilgrims seeking miraculous healing in the elevator lobby.
...and you should treat that as a warning of what you're in for: a long and bitter code-wrangling, to do something that you probably should've done some other way.
Magic! Send the .xlsm attached to an email. Send email to yourself and download the attachment. Launch, enable content received by Internet, enable macro execution. Problem disappeared.