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