拯救局域网龟速打开共享Excel工作簿的问题
最近遇到一个问题,就是用VBA从局域网打开共享的EXCEL工作簿很慢,有时会卡死,网上没有到合适的解决方案,头秃了一晚上终于测试通过了一段代码总结出来。下面先分
解决思路是:通过XMLHTTP取得服务器上的EXCEL文件,然后在客户端保存为临时EXCEL文件,再从本地文件提取数据,直接奉上代码:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' OpenNetExcel 从互联网/局域网读取EXCEL文件
'
'
' 若5秒钟未能取回则退出程序并弹窗提示
'
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub OpenNetExcel()
'临时文件预处理
Dim tempFileName As String
If Dir(ThisWorkbook.Path & "\Temp" & Format(Timer(), "00000000") & ".xlsx") = "" Then tempFileName = ThisWorkbook.Path & "\Temp" & Format(Timer(), "00000000") & ".xlsx"
Else
Kill ThisWorkbook.Path & "\Temp" & Format(Timer(), "00000000") & ".xlsx"
End If
'远程获取EXCEL文件
Dim xHttp As Object
Dim StartTime, UsedTime As Single
StartTime = Timer
Set xHttp = CreateObject("lhttp")
xHttp.Open "get", "file:\\127.0.0.1\JamesShare\netdatatesting.xlsx", False '异步请求xHttp.send
Do adystate <> 4 And xHttp.Status <> 200
UsedTime = Timer - StartTime
If UsedTime >= 5 Then '超过5秒钟退出程序
xHttp.abort
Set xHttp = Nothing
MsgBox "获取远程数据超时"
Exit Sub
End If
DoEvents自动弹窗代码
Loop
UsedTime = Timer - StartTime
Debug.Print "获取远程文件耗时:" & CStr(UsedTime) & "s"
'将获取的数据保存为临时文件
StartTime = Timer
Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")
With BinaryStream
.Type = 1 '1 Binary data
.Open
.sponsebody
.Position = 0
.savetofile tempFileName
End With
Set BinaryStream = Nothing
Set xHttp = Nothing
'打开临时存储的EXCEL文件并处理数据
Set NewApp = CreateObject("Excel.Application")
Dim wb As Excel.Workbook
NewApp.Visible = False '后台打开文件
Set wb = NewApp.Workbooks.Open(tempFileName, ReadOnly)
UsedTime = Timer - StartTime
Debug.Print "本地处理文件耗时:" & CStr(UsedTime) & "s"
''''''''''''''''''''''''''''''''''''
'
'此处放入处理数据代码段
'
'
''''''''''''''''''''''''''''''''''''
Debug.Print "Sheets(1)A1= " & CStr(wb.Sheets(1).Cells(1, 1))
Debug.Print "Sheets(2)A2= " & CStr(wb.Sheets(2).Cells(2, 1))
'
'
'
'关闭并删除临时文件,释放资源
wb.Close
Set NewApp = Nothing
Kill tempFileName
End Sub
以临时文件的方式处理的好处是无论原始Excel文件的数据结构做出哪些调整,都不必修改这部分代码;缺点是若程序出现异常中止,本地存储器上可能存在没有被删除的临时文件。若在相对固定的数据结构下可以在代码中直接将取得的XML装载到workbook对象变量中来完善这个问题。

版权声明:本站内容均来自互联网,仅供演示用,请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198,我们将在24小时内删除。