vba之小功能记录--根据内容，另存文件到指定文件夹

编码环境： office2003
背景环境：技术部要求添加功能，实现根据合同及项目名，自动创建文件夹及文件。
程序代码:

Dim htobj As Object
Dim modobj As Object
'''''''指定日期格式'''''''
    idate = Format(Date, "yy.MM.dd")
    cname = 合同名称
    obname = 项目名称
    name =制作人
    what =名牌
'''''''创建文件夹'''''''    
Set oFso = CreateObject("Scripting.FileSystemObject")

    oFso.CreateFolder ("D:/工作")

    oFso.CreateFolder ("D:/工作/" & obname & " " & cname & "-" & idate & " (" & name & ")")

    oFso.CreateFolder ("D:/工作/" & obname & " " & cname & "-" & idate & " (" & name & ")/" & obname & " " & cname & " 电气BOM/")

    oFso.CreateFolder ("D:/工作/" & obname & " " & cname & "-" & idate & " (" & name & ")/" & obname & " " & cname & " 机械BOM/")

If what = EXPRESS Then
Set htobj = Workbooks.Add    //新建一个excel
'''''''复制sheets表'''''''
modobj.Worksheets("表1").Copy before:=htobj.Worksheets(1)
'''''''清楚内容'''''''
modobj.Worksheets("表2").Range("a1:z500").ClearContents
yt = 10
For i = 1 To 9
    For j = 1 To 26
        modobj.Worksheets("表2").Cells(i, j) = modobj.Worksheets("表3").Cells(i, j)  //复制内容
    Next j
Next i

For i = 10 To 500
    shl = CDbl(modobj.Worksheets("表3").Cells(i, 6))
    If shl > 0 And shl <> 空值 Then
    For j = 1 To 26
        modobj.Worksheets("表2").Cells(yt, j) = modobj.Worksheets("表3").Cells(i, j)   //清除公式
    Next j
    yt = yt + 1
    End If
Next i

    ''''''文件另存''''''
        ActiveWorkbook.SaveAs Filename:="D:/工作/" & obname & " " & cname & "-" & idate & " (" & name & ")/" & obname & " " & cname & " 川奥采购订单.xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End If

来自 “ ITPUB博客 ” ，链接：http://blog.itpub.net/29987527/viewspace-1311788/，如需转载，请注明出处，否则将追究法律责任。

转载于:http://blog.itpub.net/29987527/viewspace-1311788/