VBA SysCmd编译错误(子或函数未定义)

时间:2015-03-16 18:51:09

标签: excel vba excel-vba

我是开发VBA代码的新手,我正在研究从Excel文档运行的函数,目标是将文件上传到sharepoint传递用户凭据,当我编译它时我在SysCmd上出错(Sub或Function not请提出建议......提前谢谢。

该功能由Excel触发,

Public Sub CopyToSharePoint()

On Error GoTo err_Copy

    Dim xmlhttp
Dim sharepointUrl
Dim sharepointFileName
Dim tsIn
Dim sBody
Dim LobjXML As Object
Dim UserName As String
Dim pw As String
Dim RetVal
Dim i As Integer
Dim TotFiles As Integer
Dim Start As Date, Finish As Date
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fldr As Object 'Folder
Dim f As Object 'File

Set fldr = fso.GetFolder("c:\vba2sharepoint\")

UserName = "mysharepointusername@domain.com" 
pw = "mysharepointpassword" 
sharepointUrl = "https://mysite.sharepoint.com/sites/xyz-uat/_layouts/15/start.aspx#/a1docsuat/"

Set LobjXML = CreateObject("Microsoft.XMLHTTP")

TotFiles = fldr.Files.Count

For Each f In fldr.Files

 sharepointFileName = sharepointUrl & f.Name

    Set tsIn = f.OpenAsTextStream
    sBody = tsIn.ReadAll
    tsIn.Close

    Set xmlhttp = CreateObject("MSXML2.XMLHTTP.6.0")

    xmlhttp.Open "PUT", sharepointFileName, False, UserName, pw

    xmlhttp.Send sBody

  i = i + 1

  RetVal = SysCmd(acSysCmdSetStatus, "File " & i & " of " & TotFiles & " copied...")

Next f

   RetVal = SysCmd(acSysCmdClearStatus)

  Set LobjXML = Nothing

  Set fso = Nothing

err_Copy:

MsgBox Err & " " & Err.Description

If Err <> 0 Then
  MsgBox Err & " " & Err.Description
  Resume Next
End If

End Sub

1 个答案:

答案 0 :(得分:2)

SysCmd是MS Access方法(Application.SysCmd Method),而不是Excel方法。

您希望将状态栏文本直接设置为传递给Application.StatusBar对象的字符串。

 dim msg as string
 msg = "New Statusbar text"
 Application.StatusBar = msg
 Application.StatusBar = "other text"

最后两行中的任何一行都将设置状态栏文本。要删除自定义文字,请将其设置为vbNullString

 Application.StatusBar = vbNullString

请参阅Application.StatusBar Property (Excel)上的此Excel属性参考。