中燃料场报表保存到文件--出库报表

 

 

Sub CmdGroup1Save()
'
' 保存出库报表到文件
'


    '判断当前数据表是否为刚生产的出库报表

    If Range("A1") <> "材料出库明细表" Then
        MsgBox "当前数据表不是 《材料出库明细表》，请确认！"
        End '结束程序的运行
    End If

    
    '在桌面上创建需要保存文件的文件夹
    
    Dim mFolderPath As String
        mFolderPath = "C:\Users\Hlj\Desktop\出入库报表" + Format(Date, "m-d")
        
    If Dir(mFolderPath, vbDirectory) = "" Then
        MkDir mFolderPath
    End If


    '创建需要的报表文件
    Dim mFilePath As String
        mFilePath = mFolderPath + "\广宗-出库" + Format(Date, "m-d") + ".xls"
        
        
    '当前文件夹的名字
    Dim mFileName As String
    mFileName = ActiveWorkbook.Name

    '如果文件已经存在就删除已经存在的文件
    If Dir(mFilePath) <> "" Then
        Kill mFilePath
'        MsgBox "已经删除存在的文件"
    End If
    
    Dim mNewBook As Workbook
    Set mNewBook = Workbooks.Add
    With mNewBook
'        .Title = "All Sales"
'        .Subject = "Sales"
        .SaveAs Filename:=mFilePath
    End With
    
    'MsgBox mFileName

    '复制数据并保存
     Workbooks(mFileName).Sheets("广宗料场出库明细").Cells.Copy ActiveWorkbook.Sheets("sheet1").Range("a1")
     ActiveWorkbook.Save
     ActiveWorkbook.Close

    MsgBox mFilePath + " 文件已经保存"
End Sub