I am naive to scripts, and I started working with Excel macros. I am looking for a macro to rename only the file extension from *.xml to *.qml. The *.xml file is in the same workbook path. So, I appreciate if anyone could help in this.
Try following code:
Sub RenameFiles()
Dim StrFile As String, newName As String
Dim filePath As Variant
filePath = ActiveWorkbook.Path & "\"
StrFile = Dir(filePath & "*.xml")
Do While Len(StrFile) > 0
newName = Replace(StrFile, ".xml", ".qml")
Name filePath & StrFile As filePath & newName
StrFile = Dir
Loop
End Sub
NOTE: Code will rename all .xml files to .qml so its better to take the back up before executing the code.
Related
I have need help to copy multiple file into a folder after download.
The file after download default rename as:
Branch_A.xlsx
Branch_A (1).xlsx
Branch_A (2).xlsx
Here code normally i use but this code only copy one file to a folder.
I need the code can capture words "Branch_A" then count file and copy to folder Branch_A. The count file is fix 3 its will come 4..5..6..
Sub down1()
'RENAME FILE DOWNLOAD BY BRANCHES
Dim Ws As Worksheet
Dim FromPath As String
Dim ToPath As String
Set Ws = ThisWorkbook.Worksheets("Path_Down1")
'FROM DOWNLOAD - C:\Users\Downloads\
FromPath = Ws.Range("E11").Value
'TO FOLDER - D:\Inbound\Branch_A\
ToPath = Ws.Range("F11").Value
Ws.Activate
FileCopy FromPath, ToPath
End Sub
I search few website and found that the code can count the file base on extention but i don't know how to edit to count by name and copy to folder. Here sample code:
Sub sample()
Dim FolderPath As String, path As String, count As Integer
FolderPath = "C:\Documents and Settings\Santosh\Desktop"
path = FolderPath & "\*.xls"
Filename = Dir(path)
Do While Filename <> ""
count = count + 1
Filename = Dir()
Loop
Range("Q8").Value = count
'MsgBox count & " : files found in folder"
End Sub
Thanks for your help.
Is the code below something you're looking for? This is what I could come up with what made sense to me. If not please provide more information as to what the issue is.
Sub Down1()
Dim FromFolder As String, ToFolder As String
Dim FromPath As String, ToPath As String, ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Path_Down1")
FromFolder = ws.Range("E11").Value
ToFolder = ws.Range("F11").Value
Filename = Dir(FromFolder & "\*.xlsx")
Do While Filename <> ""
If InStr(Filename, "Branch_A") > 0 Then
FromPath = FromFolder & "\" & Filename
ToPath = ToFolder & "\" & Filename
FileCopy FromPath, ToPath
End If
Filename = Dir()
Loop
End Sub
I'm trying to loop through all files in a given directory using VBA and replace a few words in each file before saving it in another directory. The method I'm using is:
With Application
Do While Len(fileName) > 0
Where fileName is:
fileName = Dir$("C:\FOLDER\" & "*")
After I run the code I have:
fileName = Dir
Loop
However, after it goes back to the top of the loop, it does not pick up any more files. I am sure there are multiple files in the given directory.. Any ideas?
Test it in separate Subs, this two codes works.
Sub LoopAllFiles()
Dim StrFile As String
StrFile = Dir$("C:\FOLDER\" & "*")
Do While Len(StrFile) > 0
StrFile = Dir
Loop
End Sub
Sub LoopAllFiles()
Dim StrFile As String
StrFile = Dir("C:\FOLDER\" & "*")
Do While StrFile <> ""
StrFile = Dir
Loop
End Sub
I am currently trying to put a macro together to sort files into folders based on a filename. I am locked into using VBA due to the system we are on.
For example sorting just the excel documents from below present in C:\ :
123DE.xls
124DE.xls
125DE.xls
124.doc
123.csv
into the following folder paths:
C:\Data\123\Data Extract
C:\Data\124\Data Extract
C:\Data\125\Data Extract
The folders are already created, and as in the example are named after the first x characters of the file. Batches of 5000+ files will need to be sorted into over 5000 folders so im trying to avoid coding for each filename
I am pretty new to VBA, so any guidance would be much appreciated. So far I have managed to move all the excel files into a single folder, but am unsure how to progress.
Sub MoveFile()
Dim strFolderA As String
Dim strFolderB As String
Dim strFile as String
strFolderA = "\\vs2-alpfc\omgusers7\58129\G Test\"
strFolderb = "\\vs2-alpfc\omgusers7\58129\G Test\1a\"
strFile = Dir(strFolderA & "*.xlsx*")
Do While Len(strFile) >0
Name StrFolderA & strFile As strFolderB & strFile
strFile = Dir
Loop
End Sub
Greg
EDIT
Sub MoveFile()
Dim strFolderA As String
Dim strFile As String
Dim AccNo As String
strFolderA = "\\vs2-alpfc7\omgUSERS7\58129\G Test\"
strFile = Dir(strFolderA & "*.xlsx*")
Do While Len(strFile) > 0
AccNo = Left(strFile, 2)
Name strFolderA & strFile As strFolderA & "\" & AccNo & "\Data Extract\" & strFile
strFile = Dir
Loop
End Sub
Thanks folks, are a few more bits and pieces i want to add, but functionality is there!
Sub DivideFiles()
Const SourceDir = "C:\" 'where your files are
Const topdir = "\\vs2-alpfc\omgusers7\58129\G Test\"
Dim s As String
Dim x As String
s = Dir(SourceDir & "\*.xls?")
Do
x = Left(s, 3) 'I assume we're splitting by first three chars
Name SourceDir & s As topdir & s & "\" & s
Loop Until s = ""
End Sub
If I understand you correctly, the problem is deriving the new fullpathname from the file name to use as the newpathname argument of the Name function.
If all of your files end with DE.XLS* you can do something like:
NewPathName = C:\Data\ & Split(strFile, "DE")(0) & "\Data Extract\" & strFile
You could use Filesystem object (tools > references > microsoft scripting runtime
This does a copy first then delete. You can comment out delete line and check copy is safely performed.
If on Mac replace "\" with Application.PathSeparator.
Based on assumption, as you stated, that folders already exist.
Option Explicit
Sub FileAway()
Dim fileNames As Collection
Set fileNames = New Collection
With fileNames
.Add "123DE.xls"
.Add "124DE.xls"
.Add "125DE.xls"
.Add "124.doc"
.Add "123.csv"
End With
Dim fso As FileSystemObject 'tools > references > scripting runtime
Set fso = New FileSystemObject
Dim i As Long
Dim sourcePath As String
sourcePath = "C:\Users\User\Desktop" 'where files currently are
For i = 1 To fileNames.Count
If Not fso.FileExists("C:\Data\" & Left$(fileNames(i), 3) & "\Data Extract\" & fileNames(i)) Then
fso.CopyFile (sourcePath & "\" & fileNames(i)), _
"C:\Data\" & Left$(fileNames(i), 3) & "\Data Extract\", True
fso.DeleteFile (sourcePath & "\" & fileNames(i))
End If
Next i
End Sub
I am trying to open file from the same folder as the main workbook. The problem is that the name is not permanent and just one word stays always inside the name - "NAME".
I want to use specific method with Thisworkbook.Path to open the xlsx file but it is not finding the workbook with the code.
that is the relavant part of code:
Sub RemoveDuplicats()
Dim Harel As Workbook
Dim SAP As Workbook
Dim Path As String
Dim Found As String
Path = ThisWorkbook.Path
Found = Dir(Path & "*NAME*.xlsx") 'open SAP report
If Found <> "" Then
Set SAP = Workbooks.Open(Path & Found)
End If
End Sub
ThisWorkbook.Path Returns the path without trailing backslash,
try
Found = Dir ( Path & "\" & "*NAME*.xlsx")
You would need to Loop though all Fiels in this Folder and compare the File Names like this:
Dim StrFile As String
StrFile = Dir(ThisWorkbook.Path & "\*" & ".xlsm")
Do While Len(StrFile) > 0
If StrFile Like "*Name*" Then
MsgBox StrFile 'This will be your File
End If
StrFile = Dir
Loop
I have a series of CSV files that come to me bundled in a folder simply named for the month. I've got code working to find them, open them, parse them and I'm having trouble saving them the way I want to. What I'm aiming at is saving as the same file name as it was just in the new and parsed format.
Sub OpenCSVs_2()
Dim MyFiles As String, ThisMonth As String, Convert As String
Dim startPath As String
ThisMonth = Format(Date, "mmmm")
startPath = "C:\Users\ME\Desktop\CSV find convert tests\" & ThisMonth & "\"
MyFiles = Dir(startPath & "*.csv")
Convert = Dir(startPath & "*xlsx")
Do While MyFiles <> ""
Workbooks.Open startPath & MyFiles
Call Parse1
ActiveWorkbook.SaveAs Filename:="startPath & Convert", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
MyFiles = Dir '<----------------error happens here
Loop
End Sub
The above actually does something and creates an xlsm file names "startPath & Convert". I'm sure the solution is right in front of me.
As with my previous post, you are putting your variables in quotes which then turns it into a string. so first, remove the quotes on startPath & MyFiles, then just replace the extension using the function Replace. I also added the Workbook object as you should avoid using Activeworkbook as it can cause issues.
Sub OpenCSVs_2()
Dim MyFiles As String, ThisMonth As String
Dim startPath As String
Dim wb As Workbook
ThisMonth = Format(Date, "mmmm")
startPath = "C:\Users\ME\Desktop\CSV find convert tests\" & ThisMonth & "\"
MyFiles = Dir(startPath & "*.csv")
Do While MyFiles <> ""
Set wb = Workbooks.Open(startPath & MyFiles)
Call Parse1
wb.SaveAs Filename:=startPath & Replace(MyFiles, ".csv", ".xlsx"), FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
MyFiles = Dir
Loop
End Sub