lh

Public Class Form1
    Public FileAddress As String
    Public ExcelAddress As String
    Private Sub MoveFile(ByVal N As String, ByVal Suffix As String)


        Dim xlApp As Object
        Dim xlBook As Object
        Dim xlsSheet As Object




        Dim NumberRow As Integer


        Dim Y As String
        Dim Y1 As String
        Dim M As String
        Dim M1 As String
        Dim Excel As String
        Dim File As String
        Dim File1 As String
        Dim File2 As String




        Excel = ExcelAddress
        xlApp = CreateObject("Excel.Application") '创建EXCEL对象
        xlBook = xlApp.Workbooks.Open(Excel) '打开已经存在的EXCEL工件簿文件
        xlsSheet = xlBook.Worksheets(N)  '指定工作表，也可以使用"sheet2"


        M1 = FileAddress & "\" & N  '获取目标地址
        M = M1




        Y1 = FileAddress    '获取原地址
        Y = Y1


        If Dir(M1, vbDirectory) = "" Then
            MkDir(M1)
        End If


        For NumberRow = 2 To 1000 Step 1
            If xlsSheet.cells(NumberRow, 1).value <> "" Then
                File1 = xlsSheet.cells(NumberRow, 1).value
                File2 = xlsSheet.cells(NumberRow, 2).value
                File = xlsSheet.cells(NumberRow, 1).value & "_" & xlsSheet.cells(NumberRow, 2).value


                Y = Y1 & "\" & File & Suffix
                M = M1 & "\" & File & Suffix
                FileCopy(Y, M)
            Else
                Exit For
            End If
        Next


        xlBook.close(True)
        xlApp.quit()
        xlsSheet = Nothing
        xlBook = Nothing
        xlApp = Nothing




    End Sub
    Private Sub CreatExcel(ByVal N As String)
        Dim xlApp As Object
        Dim xlBook As Object
        Dim xlBook1 As Object
        Dim xlsSheet As Object
        Dim xlsSheet1 As Object




        Dim Y As String
        Dim M As String
        Dim M_File As String
        Dim Excel As String
        Dim ExcelName As String


        Excel = ExcelAddress


        Y = Application.StartupPath & "\Data\ORFile.xlsx"


        xlApp = CreateObject("Excel.Application") '创建EXCEL对象
        xlBook = xlApp.Workbooks.Open(Excel) '打开已经存在的EXCEL工件簿文件(第一个EXCEL)
        xlBook1 = xlApp.Workbooks.Open(Y) '打开原始的存在程序根目录下的EXCEL工件簿文件(第二个EXCEL，用于生成要用的EXCEL)
        xlsSheet = xlBook.Worksheets(N)  '指定工作表，也可以使用"sheet2"


        ExcelName = xlBook.name   ''用于得到打开的EXCEL的名称
        M = FileAddress & "\" & N & "\" & N & "-" & ExcelName   '获取目标文件地址
        M_File = FileAddress & "\" & N


        If Dir(M_File, vbDirectory) = "" Then
            MkDir(M_File)
        End If


        FileCopy(Y, M)


        xlBook1 = xlApp.workbooks.open(M)
        xlsSheet1 = xlBook1.worksheets(1)




        xlsSheet.copy(xlsSheet1)
        xlBook1.save()


        xlBook.close(True)
        xlApp.quit()
        xlsSheet = Nothing
        xlBook = Nothing
        xlApp = Nothing


    End Sub




    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles B1.Click


        Dim N As String
        Dim Suffix As String




        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''机加工件的操作
        If C1.Checked = True Then
            N = "机加工件"
            If C5.Checked = True Then
                Suffix = ".pdf"
                MoveFile(N, Suffix)
            End If


            If C6.Checked = True Then
                Suffix = ".dwg"
                MoveFile(N, Suffix)
            End If


            If C7.Checked = True Then
                Suffix = ".step"
                MoveFile(N, Suffix)
            End If


            CreatExcel(N)
        End If


        '’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘钣金件的操作
        If C2.Checked = True Then
            N = "钣金件"


            If C5.Checked = True Then
                Suffix = ".pdf"
                MoveFile(N, Suffix)
            End If


            If C6.Checked = True Then
                Suffix = ".dwg"
                MoveFile(N, Suffix)
            End If


            If C7.Checked = True Then
                Suffix = ".step"
                MoveFile(N, Suffix)
            End If
            CreatExcel(N)
        End If


        '‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘焊接件的操作
        If C3.Checked = True Then
            N = "焊接件"


            If C5.Checked = True Then
                Suffix = ".pdf"
                MoveFile(N, Suffix)
            End If


            If C6.Checked = True Then
                Suffix = ".dwg"
                MoveFile(N, Suffix)
            End If


            If C7.Checked = True Then
                Suffix = ".step"
                MoveFile(N, Suffix)
            End If
            CreatExcel(N)
        End If




        '‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’订制标准件的操作
        If C4.Checked = True Then
            N = "订制标准件"


            If C5.Checked = True Then
                Suffix = ".pdf"
                MoveFile(N, Suffix)
            End If


            If C6.Checked = True Then
                Suffix = ".dwg"
                MoveFile(N, Suffix)
            End If


            If C7.Checked = True Then
                Suffix = ".step"
                MoveFile(N, Suffix)
            End If
            CreatExcel(N)
        End If
        '’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘’‘相关操作结束
        MsgBox("所有文件已经移动完成", , "提示")


    End Sub


    Private Sub FBD1_HelpRequest(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles FBD1.HelpRequest


    End Sub


    Private Sub B2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles B2.Click
        FBD1.ShowDialog()
        FileAddress = FBD1.SelectedPath
        T1.Text = FileAddress


    End Sub


    Private Sub B3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles B3.Click
        OFD1.ShowDialog()
        ExcelAddress = OFD1.FileName
        T2.Text = ExcelAddress


    End Sub
End Class