+ Reply to Thread
Results 1 to 2 of 2

Renaming Files

  1. #1
    Gordon
    Guest

    Renaming Files

    Hi

    I have a collection of randomly titled excel files in a folder called Raw1.
    The only thing these files have in common is that on a sheet called summary,
    in cell D3, there is a random text string containing a random number. The
    code below is my unsuccessful stab at cycling through these files,
    identifying the random number within the random text string on D3, then
    saving the file with the identified number to the target destination file.
    Look at the following code. It creates the destination folder and says the
    task has been completed (done), but no files are converted and placed in the
    destination folder. I'm at my wits end! I run Excel 2003 on XP pro.

    Thanks...


    Sub FileNamer()
    Dim FilePath As String
    Dim FileName As String
    Dim aStart As Integer
    Dim DestPath As String

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    'EDIT TO MATCH PATH THAT CONTAINS YOUR FILES
    FilePath$ = "C:\Documents and Settings\cartwrig\Desktop\Raw1\"

    'EDIT TO MATCH FOLDER TO HOLD YOUR NEW FILES (MUST BE DIFFERENT FROM Source
    Dir)
    DestPath$ = "C:\tested\"
    If Dir(DestPath$, vbDirectory) = "" Then MkDir (DestPath$)

    FileName$ = Dir(FilePath$ & "*.xls")
    Do Until FileName$ = ""
    Workbooks.Open FilePath$ & FileName$, 0, 1

    a$ = Workbooks(FileName$).Sheets("Summary").Range("D3").Value

    For x = 1 To Len(a$)
    If IsNumeric(Mid(a$, x, 1)) = True Then
    aStart = x
    a$ = Right(a$, Len(a$) - aStart + 1)
    a$ = Trim(Left(a$, InStr(a$, " ")))
    GoTo NumFound
    End If
    Next
    NumFound:
    ActiveWorkbook.SaveAs DestPath$ & a$ & ".xls"
    ActiveWorkbook.Close 0


    FileName$ = Dir

    Loop
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "done"
    End Sub



  2. #2
    NickHK
    Guest

    Re: Renaming Files

    Gordon,
    May help:
    Dim WB as Workbook
    Set WB=Workbooks.Open FilePath$ & FileName$, 0, 1
    a$ = WB.Sheets("Summary").Range("D3").Value
    ....
    WB.SaveAs DestPath$ & a$ & ".xls"

    Also, you do not need the "GoTo NumFound"; use Exit For instead.

    Add a Debug.Print DestPath$ & a$ & ".xls", just before the .saveAs to see
    exact where you think you will save.

    NickHK
    P.S. It's normally a good idea to always use "Option Explicit" in all
    modules.


    "Gordon" <[email protected]> wrote in message
    news:[email protected]...
    > Hi
    >
    > I have a collection of randomly titled excel files in a folder called

    Raw1.
    > The only thing these files have in common is that on a sheet called

    summary,
    > in cell D3, there is a random text string containing a random number. The
    > code below is my unsuccessful stab at cycling through these files,
    > identifying the random number within the random text string on D3, then
    > saving the file with the identified number to the target destination file.
    > Look at the following code. It creates the destination folder and says the
    > task has been completed (done), but no files are converted and placed in

    the
    > destination folder. I'm at my wits end! I run Excel 2003 on XP pro.
    >
    > Thanks...
    >
    >
    > Sub FileNamer()
    > Dim FilePath As String
    > Dim FileName As String
    > Dim aStart As Integer
    > Dim DestPath As String
    >
    > Application.ScreenUpdating = False
    > Application.Calculation = xlCalculationManual
    >
    > 'EDIT TO MATCH PATH THAT CONTAINS YOUR FILES
    > FilePath$ = "C:\Documents and Settings\cartwrig\Desktop\Raw1\"
    >
    > 'EDIT TO MATCH FOLDER TO HOLD YOUR NEW FILES (MUST BE DIFFERENT FROM

    Source
    > Dir)
    > DestPath$ = "C:\tested\"
    > If Dir(DestPath$, vbDirectory) = "" Then MkDir (DestPath$)
    >
    > FileName$ = Dir(FilePath$ & "*.xls")
    > Do Until FileName$ = ""
    > Workbooks.Open FilePath$ & FileName$, 0, 1
    >
    > a$ = Workbooks(FileName$).Sheets("Summary").Range("D3").Value
    >
    > For x = 1 To Len(a$)
    > If IsNumeric(Mid(a$, x, 1)) = True Then
    > aStart = x
    > a$ = Right(a$, Len(a$) - aStart + 1)
    > a$ = Trim(Left(a$, InStr(a$, " ")))
    > GoTo NumFound
    > End If
    > Next
    > NumFound:
    > ActiveWorkbook.SaveAs DestPath$ & a$ & ".xls"
    > ActiveWorkbook.Close 0
    >
    >
    > FileName$ = Dir
    >
    > Loop
    > Application.ScreenUpdating = True
    > Application.Calculation = xlCalculationAutomatic
    > MsgBox "done"
    > End Sub
    >
    >




+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1