pdftables-vba--2015-07-07

'--- 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 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=INSERTKEYHERE&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