Solved

Re-Name .Jpg with one click... ( photo 01, photo 02...)

Posted on 2003-11-02
5
319 Views
Last Modified: 2010-05-01
How can i re-name my photos atomatcly, whit one click...

I get his code...

Dim i As Integer
Dim strNomeNovo As String
Dim strNomeAntigo As String
With Application.FileSerch
 .NewSearch
 .LookIn = Text2.Text
 .SearchSubFolders = Text3.Text
 .FileName = ".jpg"

 If .Execute() > 0 Then
 For i = 1 To .FoundFiles.Count
 strNomeAntigo = .FoundFiles(i)
 strNomeNovo = .LookIn & "\" & Text1.Text & Format$(i, "000#") & ".jpg"
 Name strNomeAntigo As strNomeNovo
   Next i
   MsgBox "Arquivos renomeados com sucesso."
   Else
      MsgBox "Nenhum arquivo .jpg localizado."


 End If
End With
End Sub



BUT, my VB6.0 not like this line of code (With Application.FileSerch)

HELP ME PLEASE!!!!!!!!
0
Comment
Question by:Gehr
  • 4
5 Comments
 
LVL 24

Expert Comment

by:R_Rajesh
ID: 9665720
try this, renames all jpeg files in c:\temp to photo0001, photo0002....

---------------------
Sub asdf()
Dim i As Integer
Dim strNomeNovo As String
Dim strNomeAntigo As String
With Application.FileSearch
    .NewSearch
    .LookIn = "C:\temp"
    .SearchSubFolders = False
    .Filename = "*.jpg"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
strNomeAntigo = .FoundFiles(i)
strNomeNovo = "c:\temp\Photo" & Format$(i, "000#") & ".jpg"
Name strNomeAntigo As strNomeNovo
Next i
MsgBox "Arquivos renomeados com sucesso."
Else
MsgBox "Nenhum arquivo .jpg localizado."
End If
End With
End Sub
--------------
0
 
LVL 24

Expert Comment

by:R_Rajesh
ID: 9665727
actyally your code seems to work fine on my system, so whats the problem??
0
 
LVL 24

Accepted Solution

by:
R_Rajesh earned 125 total points
ID: 9665758
oh sorry, i tried the code in excel. I did not see the last line of your comment, the code works fine on vba if you want to use the same code on vb you have to create an excel or word object in vb (set xl = createobject("excel.application") and then you can use xl.filesearch in vb (at least i think so, dont have access to a system with vb right now)
0
 
LVL 17

Expert Comment

by:zzzzzooc
ID: 9665784
Perhaps something such as the below:

Private Sub Form_Load()
    Dim sPath As String, iCount As Integer, sFile As String
    sPath = "c:\tmp\"
    sFile = Dir(sPath, vbNormal)
    Do Until sFile = ""
        If LCase(Right(sFile, 3)) = "jpg" Then
             Name sPath & sFile As sPath & Format(iCount, "000#") & ".jpg"
        End If
        sFile = Dir()
        iCount = iCount + 1
        DoEvents
    Loop
End Sub
0
 
LVL 24

Expert Comment

by:R_Rajesh
ID: 9665847
Gehr:

use this to search current directory and all sub directories

----------------
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 GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100
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 * MAX_PATH
cAlternate As String * 14
End Type
Function StripNulls(OriginalStr As String) As String
If (InStr(OriginalStr, Chr(0)) > 0) Then
OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
End If
StripNulls = OriginalStr
End Function
Function FindFilesAPI(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer)
Dim FileName As String
Dim DirName As String
Dim dirNames() As String
Dim nDir As Integer
Dim i As Integer
Dim hSearch As Long
Dim WFD As WIN32_FIND_DATA
Dim Cont As Integer
If Right(path, 1) <> "\" Then path = path & "\"
nDir = 0
ReDim dirNames(nDir)
Cont = True
hSearch = FindFirstFile(path & "*", WFD)
If hSearch <> INVALID_HANDLE_VALUE Then
Do While Cont
DirName = StripNulls(WFD.cFileName)
If (DirName <> ".") And (DirName <> "..") Then
If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
dirNames(nDir) = DirName
DirCount = DirCount + 1
nDir = nDir + 1
ReDim Preserve dirNames(nDir)
End If
End If
Cont = FindNextFile(hSearch, WFD)
Loop
Cont = FindClose(hSearch)
End If
hSearch = FindFirstFile(path & SearchStr, WFD)
Cont = True
If hSearch <> INVALID_HANDLE_VALUE Then
While Cont
FileName = StripNulls(WFD.cFileName)
If (FileName <> ".") And (FileName <> "..") Then
FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
FileCount = FileCount + 1
'use this maintains directory structure
'Name path & FileName As path & "Photo" & Format$(FileCount, "#000") & ".jpg"
'use this to put every thing to root of search path
Name path & FileName As "c:\temp\Photo" & Format$(FileCount, "#000") & ".jpg"

End If
Cont = FindNextFile(hSearch, WFD)
Wend
Cont = FindClose(hSearch)
End If
If nDir > 0 Then
For i = 0 To nDir - 1
FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "\", SearchStr, FileCount, DirCount)
Next i
End If
End Function
Private Sub Form_Load()
Dim SearchPath As String, FindStr As String
Dim FileSize As Long
Dim NumFiles As Integer, NumDirs As Integer
SearchPath = "c:\temp"
FindStr = "*.jpg"
FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
End Sub
-------------------
0

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now