excel 在创建新文件夹时将文件复制到新文件夹

ddrv8njm 于 2023-05-23 发布在其他

关注(0)|答案(1)|浏览(237)

我试图让Excel根据A列中输入的值创建一个文件夹，并将文档复制到新创建的文件夹中。我暂时将复制功能注解掉了。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Z As Long
    Dim xVal As String
    On Error Resume Next
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    For Z = 1 To Target.Count
        If Target(Z).Value > 0 Then
            Call MakeFolders
            'Call FileCopy
        End If
    Next
    Application.EnableEvents = True
End Sub

Sub MakeFolders()
    Dim Rng As Range
    Dim LastRow As Long
    Dim LastColumn As Long
    Dim maxRows As Integer
    Dim r As Integer
    Dim c As Integer
    Set sht = Worksheets("NPI")
    Set StartCell = Range("A2")
    LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
    LastColumn = 1
    sht.Range(StartCell, sht.Cells(LastRow, LastColumn)).Select
    Set Rng = Selection
    maxRows = Rng.Rows.Count
    For c = 1 To 1
        r = 1
        Do While r <= maxRows
            If Len(Dir(ActiveWorkbook.Path & "\" & Rng(r, c), vbDirectory)) = 0 Then
                MkDir (ActiveWorkbook.Path & "\" & Rng(r, c))
                On Error Resume Next
            End If
            r = r + 1
        Loop
    Next c
    Range("A" & Rows.Count).End(xlUp).Offset(1).Select
End Sub

'Sub FileCopy()
    'Dim SourcePath As String
    'Dim DestinationPath As String
    'SourcePath = "C:\Users\xxxxx.xxxxx\Documents\Directory\NPI\test.txt"
    'DestinationPath = "C:\Users\xxxxx.xxxxx\Documents\Directory\NPI\NP10001\test.txt"
    'FileCopy SourcePath, DestinationPath
'End Sub

我遇到了一个问题的目的地，有没有一种方法，我可以让它调用Mkdir文件夹？即使是最新的文件夹也可以。
我试着命名一个目录并手动将文件移出，但整个子目录不值得做，除非这部分是自动完成的

excel

来源：https://stackoverflow.com/questions/76308780/copying-a-file-to-new-folders-as-they-are-created

1条答案

按热度按时间

7cwmlq891#

尝试

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim cell As Range
    Dim folderPath As String, sourceFilePath As String
    Dim folderName As String, destinationFilePath As String
    
    Set wb = ThisWorkbook
    
    Set ws = wb.Sheets("Sheet1") ' Replace "Sheet1" with your sheet name
    
    If Not Intersect(Target, ws.Columns("A")) Is Nothing Then
        For Each cell In Intersect(Target, ws.Columns("A"))
            If cell.Value > 0 Then
                ' Get the folder path using the workbook's path
                folderPath = wb.Path
                
                ' Get the folder name based on the cell value
                folderName = CStr(cell.Value)
                
                ' Create the folder if it doesn't already exist
                If Len(Dir(folderPath & "\" & folderName, vbDirectory)) = 0 Then
                    MkDir folderPath & "\" & folderName
                End If
                
                'copy file
                sourceFilePath = "C:\Users\xxxxx.xxxxx\Documents\Directory\NPI\test.txt"
                destinationFilePath = folderPath & "\" & folderName & "\" & "test.txt"
                FileCopy sourceFilePath, destinationFilePath
            End If
        Next cell
    End If
    
    ' Clean up
    Set wb = Nothing
    Set ws = Nothing
End Sub

赞(0）回复(0）举报 2023-05-23

我来回答

excel 在创建新文件夹时将文件复制到新文件夹

1条答案

相关问题

热门标签

最新问答