VB 批量重命名文件

VERSION 5.00
Begin VB.Form Form1
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Rename use VB QQ 1009374598"
   ClientHeight    =   3630
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   9270
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3630
   ScaleWidth      =   9270
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1
      Caption         =   "Go"
      Height          =   495
      Left            =   3600
      TabIndex        =   6
      Top             =   2400
      Width           =   1695
   End
   Begin VB.TextBox txtPreFix
      Height          =   405
      Left            =   1680
      TabIndex        =   4
      Text            =   "Pic_"
      Top             =   1440
      Width           =   1215
   End
   Begin VB.TextBox txtDest
      Height          =   375
      Left            =   1680
      TabIndex        =   3
      Top             =   840
      Width           =   6855
   End
   Begin VB.TextBox txtSource
      Height          =   375
      Left            =   1680
      TabIndex        =   1
      Top             =   240
      Width           =   6855
   End
   Begin VB.Label Label2
      Caption         =   "PreFix:"
      Height          =   375
      Left            =   360
      TabIndex        =   5
      Top             =   1440
      Width           =   1095
   End
   Begin VB.Label lbDest
      Caption         =   "Dest Folder:"
      Height          =   375
      Left            =   240
      TabIndex        =   2
      Top             =   840
      Width           =   1215
   End
   Begin VB.Label Label1
      Caption         =   "Source Folder"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   1335
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Dim configFile As String

'读写INI例子：
Sub RWConfigFile()
    '读字符串
    Dim lng As Long
    Dim retstr As String
    retstr = String(260, 0)
    lng = GetPrivateProfileString("config", "para1", "", retstr, 256, "c:\config.ini")
    retstr = Replace(retstr, Chr(0), "")

    '读整数
    lng = GetPrivateProfileInt("config", "para2", 0, "c:\config.ini")

    '写字符串
    lng = WritePrivateProfileString("config", "para3", "写文件测试", "c:\config.ini")
End Sub

Private Sub Form_Load()

configFile = App.Path & "\config.ini"
loadConfig

End Sub

Sub loadConfig()

    Dim lng As Long
    Dim retstr As String
    retstr = String(260, 0)
    lng = GetPrivateProfileString("config", "SourceFolder", "", retstr, 256, configFile)
    retstr = Replace(retstr, Chr(0), "")
    txtSource.Text = retstr

    retstr = String(260, 0)
    lng = GetPrivateProfileString("config", "DestFolder", "", retstr, 256, configFile)
    retstr = Replace(retstr, Chr(0), "")
    txtDest.Text = retstr

     retstr = String(260, 0)
    lng = GetPrivateProfileString("config", "PreFix", "", retstr, 256, configFile)
    retstr = Replace(retstr, Chr(0), "")
    txtPreFix.Text = retstr

End Sub

Sub saveConfig()

    Dim lng As Long

    lng = WritePrivateProfileString("config", "SourceFolder", txtSource.Text, configFile)

    lng = WritePrivateProfileString("config", "DestFolder", txtDest.Text, configFile)

    lng = WritePrivateProfileString("config", "PreFix", txtPreFix.Text, configFile)

End Sub

Private Sub Command1_Click()

    Dim files, names As String, i As Integer
    Dim destFolder As String, sourceFolder As String
    Dim ext As String
    Dim preFix As String
    On Error GoTo err
    destFolder = txtDest.Text                              ' "C:\Documents and Settings\XPMUser\My Documents\My Pictures\avarta-80\OK\"
    sourceFolder = txtSource.Text                          ' "C:\Documents and Settings\XPMUser\My Documents\My Pictures\avarta-80\"
    preFix = txtPreFix.Text

    If Dir(sourceFolder, vbDirectory) = "" Then
        MsgBox "Source folder not exists"
        Exit Sub
    End If

    If Dir(destFolder, vbDirectory) = "" Then
        MkDir (destFolder)
    End If
    If Right(sourceFolder, 1) <> "\" Then sourceFolder = sourceFolder & "\"
    files = Dir(sourceFolder)
    Do While files <> ""
        i = i + 1
        names = files
        'If LCase(Right(names, 4)) = ".jpg" Then
        ext = Right(names, 4)
        'Call FileCopy(sourceFolder & names, destFolder & " Pic_" & i & ".jpg")
        Call FileCopy(sourceFolder & names, destFolder & "\" & preFix & i & ext)
        ' End If
        files = Dir
    Loop

    MsgBox "done " & i

    Exit Sub

err:
    MsgBox err.Description

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
saveConfig
End Sub