在大量图片上加上图片本身的文件名

我的图片保存在我的电脑的D：/YT文件夹下，我想把YT文件夹下所有图片都加上每一个图片本身的文件名后，再把新图片存放在D：/XY文件夹下，不用带扩展名。请高手指点，最好是完整的代码，我自己也批处理就行，我的系统是WINXP的，谢谢！ --------------------编程问答-------------------- Dim varFSO As Variant, varFolder As Folder, varFile As File
Dim TempString As String, SourceFolder As String, Target As String

    SourceFolder = "D:\YT\": Target = "D:\XY\"

    Set varFSO = CreateObject("Scripting.FileSystemObject")
    If varFSO.FolderExists(Target) <> True Then MkDir Target
    Set varFolder = varFSO.GetFolder(SourceFolder)

    For Each varFile In varFolder.Files
        TempString = Trim(Mid(varFile, InStrRev(varFile, "\") + 1))
        If Right(LCase(Trim(TempString)), 4) = (".jpg") Then
            TempString = Mid(TempString, 1, InStr(TempString, ".") - 1)
            FileCopy varFile, Target & TempString
        End If
    Next --------------------编程问答-------------------- 最后追加一句
Set varFSO = Nothing --------------------编程问答-------------------- 另一种



Option Explicit



Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long



Const MaxLFNPath = 260

Const INVALID_HANDLE_VALUE = -1



Private Type FILETIME

    dwLowDateTime As Long

    dwHighDateTime As Long

End Type



Private Type WIN32_FIND_DATA

    dwFileAttributes As Long

    ftCreationTime As FILETIME

    ftLastAccessTime As FILETIME

    ftLastWriteTime As FILETIME

    nFileSizeHigh As Long

    nFileSizeLow As Long

    dwReserved0 As Long

    dwReserved1 As Long

    cFileName As String * MaxLFNPath

    cShortFileName As String * 14

End Type



Private Sub Form_Load()

Dim WFD As WIN32_FIND_DATA

Dim hFile&, Source$, Target$, aa$, FN$, k



    Source = "D:\YT\": Target = "D:\XY\"

    hFile = FindFirstFile(Source & "*.jpg", WFD)

    If hFile <> INVALID_HANDLE_VALUE Then

        Do

            aa = Trim(Trim(Source) & Trim(WFD.cFileName))

            k = InStr(aa, Chr(0))

            If k > 0 Then

                FN = Mid(aa, 1, k - 1)

                Temp = Mid(FN, InStrRev(FN, "\") + 1)

                Temp = Mid(Temp, 1, InStrRev(Temp, ".") - 1)

                FileCopy FN, Target & Temp

'                Debug.Print FN & " " & Target & Temp

            End If

        Loop While FindNextFile(hFile, WFD)

        

        Call FindClose(hFile)

    End If

    

End Sub

补充：VB ,  基础类