Skip to content

Instantly share code, notes, and snippets.

@scraperdragon
Last active August 29, 2015 14:24
Show Gist options
  • Save scraperdragon/ff140f7cc1cdc0389e88 to your computer and use it in GitHub Desktop.
Save scraperdragon/ff140f7cc1cdc0389e88 to your computer and use it in GitHub Desktop.
Visual Basic PDF Tables demo
'--- https://support.microsoft.com/en-us/kb/195763
' NB: remove PtrSafe if old Excel
Private Declare PtrSafe Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
'--- https://support.microsoft.com/en-us/kb/195763
' NB: remove PtrSafe if old Excel
Private Declare PtrSafe Function GetTempFileName Lib "kernel32" _
Alias "GetTempFileNameA" (ByVal lpszPath As String, _
ByVal lpPrefixString As String, ByVal wUnique As Long, _
ByVal lpTempFileName As String) As Long
Private Function pdftables_key()
pdftables_key = "INSERT_KEY_HERE"
End Function
Private Function CreateTempFile(sPrefix As String) As String
'--- https://support.microsoft.com/en-us/kb/195763
' Generate the name of a temporary file
Dim sTmpPath As String * 512
Dim sTmpName As String * 576
Dim nRet As Long
nRet = GetTempPath(512, sTmpPath)
If (nRet > 0 And nRet < 512) Then
nRet = GetTempFileName(sTmpPath, sPrefix, 0, sTmpName)
If nRet <> 0 Then
CreateTempFile = Left$(sTmpName, _
InStr(sTmpName, vbNullChar) - 1)
End If
End If
End Function
Private Function pvToByteArray(sText As String) As Byte()
'--- http://tinyurl.com/vbapost
pvToByteArray = StrConv(sText, vbFromUnicode)
End Function
Private Function pvPostFile(sUrl As String, sFileName As String, Optional ByVal bAsync As Boolean) As Variant
'--- HTTP POST a file as multipart
'--- http://tinyurl.com/vbapost -- modified slightly
Const STR_BOUNDARY As String = "3fbd04f5Rb1edX4060q99b9Nfca7ff59c113"
Dim nFile As Integer
Dim baBuffer() As Byte
Dim sPostData As String
'--- read file
nFile = FreeFile
Open sFileName For Binary Access Read As nFile
If LOF(nFile) > 0 Then
ReDim baBuffer(0 To LOF(nFile) - 1) As Byte
Get nFile, , baBuffer
sPostData = StrConv(baBuffer, vbUnicode)
End If
Close nFile
'--- prepare body
sPostData = "--" & STR_BOUNDARY & vbCrLf & _
"Content-Disposition: form-data; name=""uploadfile""; filename=""" & Mid$(sFileName, InStrRev(sFileName, "\") + 1) & """" & vbCrLf & _
"Content-Type: application/octet-stream" & vbCrLf & vbCrLf & _
sPostData & vbCrLf & _
"--" & STR_BOUNDARY & "--"
'--- post
With CreateObject("Microsoft.XMLHTTP")
.Open "POST", sUrl, bAsync
.SetRequestHeader "Content-Type", "multipart/form-data; boundary=" & STR_BOUNDARY
.Send pvToByteArray(sPostData)
If Not bAsync Then
pvPostFile = .ResponseBody
End If
End With
End Function
Private Sub pdftables_worker(filename As String)
data = pvPostFile("https://pdftables.com/api?key="+pdftables_key()+"&format=xlsx-single", filename, False)
xls_file = CreateTempFile("pdf")
nFileNum = FreeFile
Dim data_bytearray() As Byte 'needed to get rid of header
data_bytearray = data
Open xls_file For Binary Lock Read Write As #nFileNum
Put #nFileNum, , data_bytearray
Close #nFileNum
Workbooks.Open (xls_file)
End Sub
Sub pdftables()
'--- https://msdn.microsoft.com/en-us/library/office/aa219843(v=office.11).aspx
'Declare a variable as a FileDialog object.
Dim fd As FileDialog
'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)
'Declare a variable to contain the path
'of each selected item. Even though the path is a String,
'the variable must be a Variant because For Each...Next
'routines only work with Variants and Objects.
Dim vrtSelectedItem As Variant
'Use a With...End With block to reference the FileDialog object.
With fd
'Use the Show method to display the File Picker dialog box and return the user's action.
'The user pressed the action button.
If .Show = -1 Then
'Step through each string in the FileDialogSelectedItems collection.
For Each vrtSelectedItem In .SelectedItems
'vrtSelectedItem is a String that contains the path of each selected item.
'You can use any file I/O functions that you want to work with this path.
'This example simply displays the path in a message box.
'MsgBox "The path is: " & vrtSelectedItem
pdftables_worker (vrtSelectedItem)
Next vrtSelectedItem
'The user pressed Cancel.
Else
End If
End With
'Set the object variable to Nothing.
Set fd = Nothing
End Sub
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment