作者：乔山办公网日期：
返回目录：excel表格制作
如果你坚持要用EXCEL。建议你用轮询的方式。每5分钟输出1个EXCEL文档。到你的web服务器上让客户下载即可。文档名建议用年月日小时分。
Private Sub CommandButton1_Click()Dim Functions As ObjectDim func As ObjectDim iTable As Object' Create the Function control (that is, the high-level Functions collection):Set oFunction = CreateObject("SAP.LogonControl.1")Set oConnection = oFunction.NewConnectionoConnection.client = "100"oConnection.Language = "EN"oConnection.user = "username"oConnection.Password = "password"oConnection.ApplicationServer = "10.1.0.1"oConnection.SystemNumber = "00"result = oConnection.Logon(0, True)Set ofun = CreateObject("SAP.FUNCTIONS")Set ofun.Connection = oConnectionSet func = ofun.Add("ENQUEUE_READ")' Set the export parameters (here, get all customers whose names start with J):func.Exports("GCLIENT") = "100"func.Exports("GUNAME") = ""func.Exports("LOCAL") = "0"Set iTable = func.Tables("ENQ")' Call the function (if the result is false, then display a message):If func.Call = True ThenSet iTable = func.Tables("ENQ") 'ENQ is the internal tableget_data iTableMsgBox "Get Data OK!e799bee5baa6e997aee7ad94e59b9ee7ad94339"ElseMsgBox " Call Failed! error: " '+ func.ExceptionEnd IfoConnection.LogoffEnd SubPublic Sub get_data(itabtable As Object)Dim vField As VariantStatic j As IntegerFor j = 1 To itabtable.RowCountThisWorkbook.Sheets(4).Cells(j, 4) = itabtable.Value(j, "GNAME") '任何一个栏位名称ThisWorkbook.Sheets(4).Cells(j, 5) = itabtable.Value(j, "GUSR")ThisWorkbook.Sheets(4).Cells(j, 6) = itabtable.Value(j, "GUSRVB")NextEnd Sub 查看原帖>>
以前做过的一个涉及文本文件的小程序，供参考。不懂的话再联系我。
Sub txt工具()
Const path1 = "excel数据源"
Const path2 = "txt结果"
Dim sj(1 To 100000, 1 To 2) '1-日期 2-开盘价
Application.ScreenUpdating = False
If ActiveSheet.Name <> "工具" Then Exit Sub
'清空结果文件
'mypath = ThisWorkbook.Path & "\" & path2
'Kill mypath & "\*.*"
'读取数据源
mypath = ThisWorkbook.path & "\" & path1
mypath2 = ThisWorkbook.path & "\" & path2
myfile = Dir(mypath & "\" & "*.xls*")
Do While myfile <> ""
If myfile = "" Then
Exit Do '当MyFile为空的时候就说e79fa5e98193e58685e5aeb9338明已经遍历完了，这时退出Do，否则还要运行一遍
End If
Set wb = Workbooks.Open(mypath & "\" & myfile)
For Each mys In wb.Sheets
shtname = mys.Name
arr = Split(myfile, ".")
txtname = arr(0) & "-" & shtname
ZZ = 1
Do While mys.Cells(2 + ZZ, 1) <> ""
sj(ZZ, 1) = mys.Cells(2 + ZZ, 1)
sj(ZZ, 2) = Round(mys.Cells(2 + ZZ, 2), 4)
ZZ = ZZ + 1
Loop
'*************
Set fs = CreateObject("Scripting.FileSystemObject")
filePath = mypath2 & "\" & txtname & ".txt"
fs.CreateTextFile filePath
Open filePath For Output As #1
Print #1, "日期,开盘价"
For j = 1 To ZZ - 1
mystr = Format(sj(j, 1), "yyyy-mm-dd") & "," & Format(sj(j, 2), "0.00%")
Print #1, mystr
Next j
Close #1
Set f = Nothing
Set fs = Nothing
Next mys
wb.Close False
myfile = Dir '第二次读入的时候不用写参数
Loop
Application.ScreenUpdating = True
End Sub
‘3030490161
可以. 但需要对应的用户有RFC权限. 通时应了解BAPI函数及登录的标准样式. 登录后调研bapi即可导出后到excel.