返回列表 上一主題 發帖

[發問] 搜尋複製問題

mark15jill
　暱稱: 隨風飄蕩的羽毛
　頭銜: [御用]潛水艇

高中生Rank: 3Rank: 3

帖子
852 
主題
79 
精華
0 
積分
918 
點名
0  
作業系統
Windows 7 , XP 
軟體版本
Office 2007, Office 2003,Office 2010,YoZo Office 
閱讀權限
50 
性別
男 
來自
宇宙 
註冊時間
2011-4-8 
最後登錄
2024-2-21 
1# 跳轉到 »
發表於 2012-3-16 14:40 | 顯示全部帖子
回復 1# imzues
版上有類似文章..
這是基礎用法. 可以視情況加以應用

    Sub ox()
    Set fd = CreateObject("scripting.filesystemobject")
        fd.copyfolder "d:\9996\995", "d:\9996\996\993\"  '995 資料夾 整份複製到 993 內
End Sub

TOP

mark15jill
　暱稱: 隨風飄蕩的羽毛
　頭銜: [御用]潛水艇

高中生Rank: 3Rank: 3

帖子
852 
主題
79 
精華
0 
積分
918 
點名
0  
作業系統
Windows 7 , XP 
軟體版本
Office 2007, Office 2003,Office 2010,YoZo Office 
閱讀權限
50 
性別
男 
來自
宇宙 
註冊時間
2011-4-8 
最後登錄
2024-2-21 
2#
發表於 2012-3-19 10:46 | 顯示全部帖子
回復 3# imzues
預設  D:\A資料夾   D:\B資料夾
動作： 從EXCEL 判斷檔名 再從A 複製到 B  (搬移會有問題)

Sub test()

    Dim objFs As Object
    Set objFs = CreateObject("Scripting.FileSystemObject")
For xt = 1 To 20
    If Range("a" & xt).Value <> "" Then
            For xuo = 1 To 20
                If Dir("d:\比對\A資料夾\" & Left(Range("a" & xt).Value, 9)) & "-051115619000-OEM-T 190.xls" <> "" Then
                        objFs.copyfile "d:\比對\A資料夾\" & Left(Range("a" & xt).Value, 9) & "*.xlsx", "D:\比對\B資料夾\"
                End If
            
            Next xuo
    End If
Next xt
   'Set objFs = Nothing
End Sub


   

text.rar (40.35 KB)

TOP

        靜思自在 : 並非有錢魷是快樂，問心無愧心最安。
返回列表 上一主題