Opening files from a folder using values stored in a range - excel

I have the following code to open a file that contains a number that is usually ten digits.
I would like the code to refer to my worksheet for that number rather than mentioning it in the code.
When I try the Range formula, it doesn't work because the number is too large to be stored as an integer. If I store this number as text, it's not able to locate the file.
Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
MyFolder = "H:\Test\" 'EXACT folder name containing the files.
'Change to suit, but don't forget the trailing backslash '\'
MyFile = Dir(MyFolder & "\*2964179000*.xlsm")
Do Until MyFile = ""
Workbooks.Open Filename:=MyFolder & "" & MyFile
MyFile = Dir
Loop
End Sub

If you need to store long numbers on the sheet then format the cell(s) as Text before adding their content.
You should be able to do something like this:
Sub OpenFiles()
Dim MyFolder As String, ws As Worksheet
Dim MyFile As String
Set ws = ThisWorkbook.Worksheets("Info") 'for example
MyFolder = "H:\Test\"
MyFile = Dir(MyFolder & "*" & ws.Range("A10").Value & "*.xlsm")
Do Until MyFile = ""
Workbooks.Open Filename:=MyFolder & "" & MyFile
MyFile = Dir
Loop
End Sub

Related

Rename multiple files by name Excel VBA

I am very new to vba and I need a excel macro that depending on the file name, assigns it another name, for example:
aaa12345.txt -----> hello.txt
bb678.txt -----> bye.txt
there are only two types of names in the folder, aaa*.txt and bb*.txt
Sub rena_me()
if ffile = Dir("C:\test\aaa*.txt") Then NewName = "yellow.txt"
Name "C:\test\" & ffile As "c:\test\" & NewName
End sub
this code is all I have got... works fine, but I don't know how to implement it for both files
Try the following macro...
Option Explicit
Sub rena_me()
Dim myPath As String
Dim myFile As String
Dim newName As String
myPath = "C:\test\"
'check for an aaa file
myFile = Dir(myPath & "aaa*.txt")
If Len(myFile) > 0 Then
Name myPath & myFile As myPath & "hello.txt"
End If
'check for a bb file
myFile = Dir(myPath & "bb*.txt")
If Len(myFile) > 0 Then
Name myPath & myFile As myPath & "bye.txt"
End If
End Sub

Get a filename from a folder using a wildcard

I'm completely new to VBA and had some trouble googling this problem cause variable has multiple meanings.
I am trying to open a file and assign its name to a variable. The file's name is never the same though I always download it to the same folder (one file in that folder only). The only recognizable thing about the file are 3 letters "ABC".
So far I managed to get opening the file to work but not assigning the non-standardized file name to a variable.
Sub openwb()
Dim wb As Workbook Dim directory As String
directory = "D:\Users\AAA\Desktop\Practice"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set folder = FSO.GetFolder(directory)
For Each file In folder.Files
If Mid(file.Name, InStrRev(file.Name, ".") + 1) = "xlsm" Then
Workbooks.Open directory & Application.PathSeparator & file.Name
End If
Next file
End Sub
Public Sub RecordFileName()
Dim sPath As String, sFile As String
Dim wb As Workbook
sPath = "D:\Users\AAA\Desktop\Practice"
sFile = sPath & "*ABC*"
End Sub
Here is a function you can use. It will return the filename you are looking for, and you can specify a file pattern if you want to, or you can omit that argument and it will assume all files.
Function GetFullFileName(sFolder As String, Optional sPattern As String = "*") As String
Dim sFile As String
' ensure sFolder ends with a backslash
If Right$(sFolder, 1) <> "\" Then sFolder = sFolder & "\"
sFile = Dir(sFolder & sPattern)
If sFile = "" Then
MsgBox "NOT FOUND: " & sFolder & sPattern
End
End If
GetFullFileName = sFolder & sFile
End Function
Usage:
MsgBox GetFullFileName("C:\Users\Fred\Documents")
Or
MsgBox GetFullFileName("C:\Users\Fred\Documents\", "*ABC*.xlsm")
Or
sFullFile = GetFullFileName("C:\Users\Fred\Documents\", "*ABC*.xlsm")

Rename specific sheet from specific folder sub folders

I have several excel files in folder & want to rename only specific sheets of every file in the folder which contains
viz. GTLB, SALARY, GROC
Every file has a single sheet of above characters, other sheets have different names.
So, if sheet name contains above characters then change it to GROCERY.
thanks in advance
Try using this it will loop through the folder try finding files (excel files) and try looking for the strings in files that have been specified and if match found change the name.
Sub LoopThroughFiles()
'loops through all files in a folder
Dim MyObj As Object, MySource As Object, file As Variant
Dim wbk As Workbook
Dim path As String
Dim st As String
file = Dir("H:\TestCopy\testing\") 'file name
path = "H:\TestCopy\testing\" 'directory path
While (file <> "")
Set wbk = Workbooks.Open("H:\TestCopy\testing\" & file)
MsgBox "found " & file
' path = path & file 'path and filename
Call newloopTrhoughBooks
wbk.Save
wbk.Close
' Call loop_through_all_worksheets(path)
file = Dir
Wend
End Sub
Sub newloopTrhoughBooks()
Dim book As Workbook, sheet As Worksheet, text As String, text1 As String
Dim logic_string As String
Dim logic_string2 As String
Dim logic_string3 As String
logic_string = "GTLB"
logic_string2 = "SALARY"
logic_string3 = "GROC"
For Each book In Workbooks
text = text & "Workbook: " & book.Name & vbNewLine & "Worksheets: " & vbNewLine
For Each sheet In book.Worksheets
text = text & sheet.Name & vbNewLine
text1 = sheet.Name
If StrComp(logic_string, text1) = 1 Or StrComp(logic_string2, text1) = 1 Or StrComp(logic_string3, text1) = 1 Then 'compare file name
ActiveSheet.Name = text1
ActiveSheet.Name = "Change1"
End If
Next sheet
text = text & vbNewLine
Next book
MsgBox text
End Sub
Sub RenameSheets()
Dim MyFolder As String
Dim MyFile As String
Dim wbname As String
MyFolder = "E:\SSS\File Name"
MyFile = Dir(MyFolder & "\*.xls")
Application.ScreenUpdating = False
Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyFile
With ActiveWorkbook
wbname = "GROCERY"
'For giving filename to sheet1
'Left(.Name, InStr(.Name, ".") - 1)
For Each sheet In ActiveWorkbook.Sheets
If LCase(sheet.Name) Like "*salary*" Or LCase(sheet.Name) Like "*gtlb*" Or LCase(sheet.Name) Like "*groc*" Then
MsgBox "Found! " & sheet.Name
.Sheets(sheet.Name).Name = wbname
.Close savechanges:=True
End If
Next
'.Sheets(1).Name = wbname
'.Close savechanges:=True
End With
MyFile = Dir
Loop
Application.ScreenUpdating = True
End Sub

Trying to rename a file in a folder (based on a string within the filename)

Hi there I am trying to create a Sub where I find a file in a folder with the name containing a specific phrase like "test_file" and rename it with a different name/extension. I have the following code that doesn't seem to work: (Also I don't know how to search for a specific string within a filename and execute the renaming according to that)
Sub ReName()
Dim myFile As String
Dim myPath As String
Dim mVal As String
mVal = "_12345678_" 'test string'
myPath = "C:\Users\bf91955\Desktop\testfolder\" 'folder path'
myFile = Dir(pathname & "*test_file*") 'real file name is 2222_test_test_file.xlsx'
myFile = myPath & myFile
NewName = "new_test_file & mVal & .xlsx" 'save it as .xlsx and with the new filename including myVal'
Name myFile As myPath & NewName 'rename
End Sub
Any help would be appreciated!
Have a look at the comments you had a couple of errors
Sub ReName()
Dim myFile As String
Dim myPath As String
Dim mVal As String
mVal = "_12345678_" 'test string'
myPath = "C:\Users\bf91955\Desktop\testfolder\" 'folder path'
'' You weren't referencing MyPath here - guessing copy and paste error
myFile = Dir(myPath & "*test_file*") 'real file name is 2222_test_test_file.xlsx'
myFile = myPath & myFile
'' This was passing the variable as part of the string
newname = "new_test_file" & mVal & ".xlsx" 'save it as .xlsx and with the new filename including myVal'
Name myFile As myPath & newname 'rename
End Sub

Open Specified Workbooks Only

I run this code daily that will affect each .xlsx workbook in the directory, but how can I ignore the workbook if the file name is not in the "Okay" array?
This is my current syntax:
Option Explicit
Public Sub OpenExcelInDir()
Dim MyFolder As String
Dim MyFile As String
MyFolder = "C:\ExcelSheets"
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""
Workbooks.Open Filename:=MyFolder & "\" & MyFile
MyFile = Dir
Call UpdateAllSheets
Loop
End Sub
Now I want to alter it so that I can declare a string array and only open the workbooks in the array something like so:
Dim goodWB() As String
goodWB= Split("ABC123,DEF456,GHI789", ",")
Even though I like the IsInArray function I think the algorithm is utterly inefficient. If you have 1000 files in that folder you will create 1000 temp arrays if one of the few given filenames match. Furthermore, I would expect that after opening one of the wanted files the code would not test against this name anymore (which is not the case).
Instead I propose to look at the problem from the other end:
Public Sub OpenExcelInDir()
Dim goodWB, filename
Dim MyFolder As String
Dim MyFile As String
goodWB = Array("ABC123.xls", "DEF456.xlsx", "GHI789.xlsx")
MyFolder = "C:\ExcelSheets"
For Each filename In goodWB
MyFile = MyFolder & "\" & filename
If Len(Dir(MyFile)) > 0 Then
Workbooks.Open filename:=MyFile
Call UpdateAllSheets
End If
Next WB
End Sub
Here, the Dir() function is used to test for the existance of the wanted filename in the specified folder. As an additional advantage there won't be any ambiguities like EEM mentioned in his/her comment.
I think this will do what you are asking for. I added a line to test if the file name matched one in the array.
Tested
Option Explicit
Public Sub OpenExcelInDir()
Dim goodWB() As String
goodWB = Split("ABC123.xlsx,DEF456.xlsx,GHI789.xlsx", ",")
Dim MyFolder As String
Dim MyFile As String
MyFolder = "C:\ExcelSheets"
MyFile = Dir(MyFolder & "\*.xlsx")
Do While MyFile <> ""
If IsInArray(MyFile, goodWB) Then
Workbooks.Open Filename:=MyFolder & "\" & MyFile
MyFile = Dir
Call UpdateAllSheets
End If
MyFile = Dir
Loop
End Sub
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
Public Sub OpenExcelInDir()
Const kExt As String = ".xlsm" `As extension is fixed it could be defined as a constant to avoid repetition
Dim aWbks As Variant, vItm As Variant ‘Suggest to define the array in one step choose the form you prefer
‘aWbks = Array("ABC123", "DEF456", "GHI789")
aWbks = [{"ABC123", "DEF456", "GHI789"}]
Dim MyFolder As String
Dim MyFile As String
MyFolder = "C:\ExcelSheets"
MyFile = Dir(MyFolder & "\*" & kExt)
Do While MyFile <> ""
For Each vItm In aWbks
If vItm & kExt = MyFile Then
Workbooks.Open Filename:=MyFolder & "\" & MyFile
Call UpdateAllSheets
Exit For
End If: Next
MyFile = Dir
Loop
End Sub

Resources