fso文件夹操作用法实操
Sub 订单转换()
Application.ScreenUpdating = False
On Error Resume Next
Dim fso, fl, m%, n%, p%, q&
Dim wb As Workbook
Dim mypath As String
Dim brr
Sheets.Add after:=Sheets(1)
ActiveSheet.Name = "汇总表"
brr = Array("序号", "商品国际码", "商品名称", "品类", "单位", "商品规格", "配送类型", "订单数", "辅助数量", "辅助单价", "优惠数量", "优惠单价", "单据类别", "供应商名称", "备注", "客户名称", "订单总数", "门店电话", "送货地址", "订单金额", "实配金额", "订单来源")
Sheets("汇总表").Range("a1:v1") = brr
Set fso = CreateObject("Scripting.FileSystemObject")
For Each fl In fso.GetFolder(CreateObject("Shell.Application").BrowseForFolder(0, "请选择文件夹", 0, "").Self.Path & "").Files
mypath = fl.Path
Set wb = GetObject(mypath)
With wb.Sheets(1)
.Range("A1:B9").Copy
.Range("M10").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=True
.Range("1:9").Delete Shift:=xlUp
m = wb.Sheets(1).Range("A65536").End(xlUp).Row
n = wb.Sheets(1).Range("M65536").End(xlUp).Row
.Range("M2:U2").Copy .Range("M" & n + 1 & ":" & "U" & m)
.Range("v1") = "订单来源"
.Range("v" & n & ":" & "v" & m) = wb.Name
End With
ThisWorkbook.Activate
p = Application.CountA(Sheets("汇总表").[a:a])
p = p + 1
wb.Sheets(1).Range("a2:v" & m).Copy ThisWorkbook.Sheets("汇总表").Cells(p, 1)
wb.Close False
Set wb = Nothing
Next
Call 订单导入
Application.ScreenUpdating = True
End Sub
posted on 2018-06-29 11:23 上山打老虎下山采蘑菇 阅读(398) 评论(0) 编辑 收藏 举报