'VBA 파일 삭제'에 해당되는 글 2건

728x90

윈도우 폴더에 있는 실제 파일이 삭제되는 VBA 코드이다.

따라서 파일 삭제를 잘못하면 되돌릴 수가 없으므로 다시 한번 확인하는 IF문을 넣었다.

Selection (선택한 셀) 로 처리를 한 이유는 선택한 셀 단위로 하나씩 확인해야지 다중으로 전체를 날리면 안되는 경우를 고려했다.

다중으로 날리려면 약간 손을 봐서 삭제를 하면 된다.


Sub File_Delete()  '// 특정 폴더의 파일 삭제
    Dim rngC, rngAll As Range
    Dim oldName, newName As String
    Dim oldPath, newPath As String
    Dim msg As String
   
    Set rngAll = Range([B2], Cells(Rows.Count, "B").End(3))
   
    For Each rngC In Selection
        oldPath = Cells(rngC.Row, "A")
        oldName = oldPath & "\" & Cells(rngC.Row, "B")
        If Dir(oldName, vbDirectory) = "" Then          '// 파일이나 폴더가 없다면
            Cells(rngC.Row, "C").Value = "파일없음"
        Else
            msg = Cells(rngC.Row, "B") & "파일 삭제가 맞나요?" & vbCr
            msg = msg & "Path : " & Cells(rngC.Row, "A") & vbCr
            msg = msg & Cells(rngC.Row, "I")
            If MsgBox(msg, vbYesNo) = vbYes Then
                On Error Resume Next
                SetAttr oldName, vbNormal       '// 파일 속성을 변경시키고
                Kill oldName                            '// 파일을 삭제하라
                On Error GoTo 0
                Cells(rngC.Row, "C").Value = "Deleted"
            Else
                newPath = "C:\Excel Basics\Delete_Items"
                newName = newPath & "\" & Cells(rngC.Row, "B")
                If MsgBox("삭제대상 폴더로 이동시키겠습니까?", vbYesNo) = vbYes Then
                    If Dir(newName, vbDirectory) = Empty Then
                        Name oldName As newName     '// 같은 파일명으로 이동됨
                        Cells(rngC.Row, "C").Value = "ReMove"
                    Else
                        newName = newPath & "\" & Split(Cells(rngC.Row, "B"), ".")(0) & "__." & Split(Cells(rngC.Row, "B"), ".")(1)
                        Name oldName As newName     '// 다른 파일명으로 이동됨
                        Cells(rngC.Row, "C").Value = "Change_Moved"
                    End If
                End If      '// 삭제대상 폴더로 이동 IF문 종료
            End If      '// 파일삭제 IF문 종료
        End If
    Next rngC
End Sub

블로그 이미지

Link2Me

,
728x90

윈도우 운영체제 기반하의 특정 폴더에서 다른 폴더로 파일을 복사할 때 사용하는 VBA 코드이다.

코드는 파일이 없을 경우, 복사하려는 위치에 파일이 존재할 경우 등이 고려된 코드다.

잘못하여 덮어쓰는 것을 방지할 필요가 있다.

경우에 따라서는 기존 파일을 덮어쓸 필요가 있는 경우도 있을 것이다.

복사에 사용되는 함수는 FSO.CopyFile oldName, newName  이며, 변수선언이 필요하다.

파일복사 명령어가 동일한 VBA.FileCopy oldName, newName 의 경우에는 FSO 변수 선언은 필요없다.

파일복사 명령어는 newPath(복사하려는 폴더) 에 파일 존재해도 복사를 한다.


Sub FSO_CopyFile()  '// 특정 폴더의 파일 복사
    Dim FSO As Object
    Dim rngC, rngAll As Range
    Dim oldName, newName As String
    Dim oldPath, newPath As String
   
    Set rngAll = Range([D2], Cells(Rows.Count, "D").End(3))     '// 복사할 파일이 있는 범위 설정
    oldPath = Cells(3, "H").Value       '// 복사할 파일의 경로
    newPath = Cells(5, "H").Value       '// 복사될 파일의 경로
    Set FSO = CreateObject("Scripting.FileSystemObject")
   
    For Each rngC In Selection      '// Selection 대신에 rngAll 을 선택하면 범위설정 구간 반복 처리
        If InStr(newPath, "교정") > 0 And Cells(rngC.Row, "F") <> "Copyed" Then  '// 파일이 복사되지 않았으면
            If Cells(rngC.Row, "E") = "교정파일" Then
                oldName = oldPath & "\" & Cells(rngC.Row, "D")
                newName = newPath & "\" & Cells(rngC.Row, "D")
               
                If Dir(oldName, vbDirectory) = "" Then          '// 파일이나 폴더가 없다면
                    Cells(rngC.Row, "F").Value = "파일없음"
                Else
                    If Dir(newName, vbDirectory) = Empty Then
                        FSO.CopyFile oldName, newName       '// 파일 복사
                        Cells(rngC.Row, "F").Value = "Copyed"
                    Else
                        Cells(rngC.Row, "F").Value = "동일파일 존재"
                    End If
                End If
            Else    '// Cells(rngC.Row, "E") 가 비어있으면
                Debug.Print rngC.Row & "행은 복사할 수 없습니다"
            End If
        Else
            Debug.Print rngC.Row & "행은 이미 복사되었습니다"
        End If
    Next rngC
End Sub


복사하려는 곳(newPaht)에 파일이 존재해도 파일 복사하고 현재 폴더(oldPath)에 있는 파일을 지우고자 한다면

                    If Dir(newName, vbDirectory) = Empty Then
                        Name oldName As newName    '// 파일을 이동시켜라
                        Cells(rngC.Row, "F").Value = "Copyed"
                    Else
                        VBA.FileCopy oldName, newName       '// 파일 복사
                        Cells(rngC.Row, "F").Value = "Copyed"
                        On Error Resume Next
                        SetAttr oldName, vbNormal     '// 파일 속성을 변경시키고
                        Kill oldName                          '// 파일을 삭제하라
                        On Error GoTo 0
                    End If

로 변경해주면 된다.


블로그 이미지

Link2Me

,