[µo°Ý] ¸ê®Æ§¨ÀɮצWºÙ¦Û°ÊÅܧó

rouber590324

DEAR ALL ¤j¤j
1.¦p¹Ï¤@¤º®e.½Ð±Ð°ÝÃD¦p¤U-
1.1 ­ìµ{¦¡¿ï¨úC:\AAA\¤U²Å¦X§ï¦WªºÀɮקï¦W«á©ñ¨ìRename¸ê®Æ§¨¤º.­ìC:\AAA\¤UÀɮפ£ÅÜ.
1.2»Ý¨D
   C:\AAA\¤U²Å¦X§ï¦WªºÀɮקï¦W«á©ñ¨ìRename¸ê®Æ§¨¤º,µM«á²¾°£C:\AAA\§ï¦W¦¨¥\ªºÀÉ®×,
   ¦ÓC:\AAA\¥¼¦¨¥\©Î«D¦¹ÅÞ¿è©Êªº¤ºªºÀÉ®×Ä~Äò«O¯d¡C
2.½Ð±Ð¦p¦ó­×§ïµ{¦¡.·Ð¤£§[½ç±Ð  THANKS*10000

¹Ï¤@
Sub test2()
Dim i As Integer
Dim FolderPath, original_file, rename_file As String   
    '¿ï¾Ü¨Ó·½Àɮ׸ê®Æ§¨
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "¿ï¾ÜÀɮרӷ½¸ê®Æ§¨"
        .Show
        FolderPath = .SelectedItems(1) & "\"
        Debug.Print FolderPath
    End With
    '²MªÅEXCEL
    If Worksheets(2).Range("A2") <> "" Then Worksheets(2).Range("A2:B" & Worksheets(2).Range("A65536").End(xlUp).Row) = ""    '§PÂ_¬O§_¦³¿ï¾Ü¨Ó·½¸ê®Æ§¨
    If FolderPath <> "" Then
        original_file = Dir(FolderPath & "*.*")
        i = 1
        Do Until original_file = ""
            i = i + 1
            Worksheets(2).Cells(i, 1) = original_file
            original_file = Dir
        Loop
        '¸ê®Æ§¨¤£¦s¦b«h·s«Ø
        If Dir(FolderPath & "\Rename", vbDirectory) = "" Then MkDir FolderPath & "\Rename"
        For i = 2 To Sheet2.Range("A65536").End(xlUp).Row
            '­×§ï²Ä¤K½X
            If Left(Worksheets(2).Range("A" & i), 12) Like "*" & "-" And Mid(Worksheets(2).Range("A" & i), 13, 3) = Sheet1.Cells(3, 4) Then
                rename_file = Mid(Worksheets(2).Range("A" & i), 1, 12) & Sheet1.Cells(3, 5) & Mid((Worksheets(2).Range("A" & i)), 16)
                Worksheets(2).Range("B" & i) = rename_file
                Call FileSystem.FileCopy(FolderPath & Worksheets(2).Range("A" & i), FolderPath & "\Rename\" & rename_file)
            End If
        Next
        Call CreateObject("WScript.Shell").Popup("§ó¦W§¹¦¨¡C", 1, "¨t²Î°T®§")
        '¶}±Òµ²ªG¸ô®|
        ActiveWorkbook.FollowHyperlink Address:=FolderPath + "\Rename\", NewWindow:=True
    End If
End Sub

rouber590324

DEAR  ALL
¤w§ä¥X ¨Ï¥Î  KILL ¥i±þ°£¤å¦rÀÉ THANKS

Sub delete_txt_file()
    Dim myName As String
   
    X = Sheet1.[C65536].End(xlUp).Row
    For Y = 2 To X
   
    myName = "C:\AAA\" & Sheet1.Cells(Y, 3) & "" '¥ô·NªºÀÉ®×
    If Len(Dir(myName)) > 0 Then
        Kill myName
    End If
     
    Next
End Sub

Sub DATA()
Sheet1.[C2:C65536].ClearContents
X = Sheet1.[A65536].End(xlUp).Row
Y = Sheet1.[C65536].End(xlUp).Row
For M = 2 To X
If Not (Sheet1.Cells(M, 2) = "" Or Sheet1.Cells(M, 2) = " ") Then
  Sheet1.Cells(Y + 1, 3) = Sheet1.Cells(M, 1)
    Y = Y + 1
  End If
  Next
End Sub