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

　　

转载于:https://www.cnblogs.com/wgscd/p/10255993.html