设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 1680|回复: 1
打印 上一主题 下一主题

[其它] [求助]如何不開Excel檔取值? =已解決=

[复制链接]
跳转到指定楼层
1#
发表于 2009-6-26 00:32:20 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
本帖最后由 andyhcc 于 2009-6-27 03:55 编辑

大家好,

以下代碼是由網路上找來的,基本上是在不開啟Excel檔案情況下,讀取儲存格內容.
但美中不足的地方是工作表名稱是定死的.不知有誰能幫忙修改為不限定工作表名稱也能正確取值,或有更好的代碼.

***補充一點***
附件中每個工作簿都只有一張工作表,只是工作表名稱都不固定.

http://www.exceltip.com/st/Read_ ... soft_Excel/473.html

Sub ReadDataFromAllWorkbooksInFolder()
Dim FolderName As String, wbName As String, r As Long, cValue As Variant
Dim wbList() As String, wbCount As Integer, i As Integer
    FolderName = "C:\Foldername"
    ' create list of workbooks in foldername
    wbCount = 0
    wbName = Dir(FolderName & "\" & "*.xls")
    While wbName <> ""
        wbCount = wbCount + 1
        ReDim Preserve wbList(1 To wbCount)
        wbList(wbCount) = wbName
        wbName = Dir
    Wend
    If wbCount = 0 Then Exit Sub
    ' get values from each workbook
    r = 0
    Workbooks.Add
    For i = 1 To wbCount
        r = r + 1
        cValue = GetInfoFromClosedFile(FolderName, wbList(i), "Sheet1", "A1")
        Cells(r, 1).Formula = wbList(i)
        Cells(r, 2).Formula = cValue
    Next i
End Sub

Private Function GetInfoFromClosedFile(ByVal wbPath As String, _
    wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
    GetInfoFromClosedFile = ""
    If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
    If Dir(wbPath & "\" & wbName) = "" Then Exit Function
    arg = "'" & wbPath & "[" & wbName & "]" & _
        wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
    On Error Resume Next
    GetInfoFromClosedFile = ExecuteExcel4Macro(arg)
End Function

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 分享淘帖 订阅订阅
2#
 楼主| 发表于 2009-6-26 11:28:51 | 只看该作者
有誰能夠幫幫忙嗎?一直找不到解決辦法
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-12 07:01 , Processed in 0.093232 second(s), 27 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表