I'm having a little trouble getting a filename using a wildcard.
I'm using a wildcard because the filename has a "version" in it so in this case "Test v*" could be "Test v1" or "Test v2" because of this I want it to pull the name of whatever version is currently on the desktop.
Here is a simplistic version of my code. if ran you get "Test v*" rather than the actual file name. Not sure what I'm missing but any help would be greatly appreciated
Dim Owner As String
Dim Cver As String
Dim FileName As String
Owner = Environ("USERNAME")
FileName = "C:\Users\" & Owner & "\Desktop\TEST v" & "*" & ".accdb"
Cver = Left(FileName, InStr(FileName, ".") - 1)
MsgBox "" & Mid(Cver, 7, 2) & ""
you are going to want to use Dir()
Here is my version of your code:
Sub getVersion()
Dim owner As String
Dim Cver As String
Dim fileName As String
Dim owner As String: owner = Environ("USERNAME")
Dim fileName As Variant: fileName = Dir("C:\Users\" & owner & "\Desktop\TEST v" & "*" & ".accdb", vbDirectory)
Cver = Left(fileName, InStr(fileName, ".") - 1)
MsgBox "" & Mid(Cver, 7, 2) & ""
End Sub
Related
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
Have a requirement to store a file in mydocuments. Save location has to be VDI or laptop independent.
I am able to successfully save the file, in the location I want. But with the same file name and location, I am unable to open it.
The path and the filename for workbooks.open is coming like this, when I am testing it thru VDI. Bit strange, I not able to open the workbook using the path I used to save it.
"\xxx.yyy.CO.NZ\PaleeS.home$\InsuranceAdvisory\Excel\DT_test delete_rectangle 1_04.May.17.xlsm"
Dim strFilename As String
Dim Client1 As Range
Dim Client2 As Range
Dim CurrentDate As String
Dim FilePrefix As String
Dim strDir As String
Dim StrDirSub As String
Dim Savedflie As String
Dim CurrentFolderpath As String
Dim CurrentFilename As String
CurrentFolderpath = Application.ActiveWorkbook.Path
CurrentFilename = Application.ActiveWorkbook.Path & "\" & Application.ActiveWorkbook.FullName
strDir = CreateObject("WScript.Shell").SpecialFolders("mydocuments") & Application.PathSeparator & "\InsuranceAdvisory"
StrDirSub = strDir & "\Excel"
If Dir(strDir, vbDirectory) = "" Then
MkDir strDir
End If
Select Case Dir(StrDirSub, vbDirectory)
Case ""
MkDir StrDirSub
End Select
FilePrefix = "\DT_"
Set Client1 = Range("Client1")
Set Client2 = Range("Client2")
CurrentDate = Format(Date, "dd.mmm.yy")
strFilename = FilePrefix & Client1.Value & "_" & Client2.Value & "_" & CurrentDate
ActiveWorkbook.Save
ActiveWorkbook.SaveCopyAs StrDirSub & strFilename & ".xlsm"
Savedflie = StrDirSub & strFilename & ".xlsm"
Application.Workbooks.Open (Savedflie)
I have a small piece of code under a command button click which saves the workbook file with a new name in a new location, I am wondering if it is possible to also automatically create a shortcut to that newly saved workbook in a different location?
Private Sub CommandButton1_Click()
Dim SelectedFNumber As String
Dim DateStr As String
Dim myFileName As String
Dim StorePath As String
DateStr = Format(Now, "dd.mm.yy HH.mm")
SelectedFNumber = Range("B4").Text
If SelectedFNumber <> "SELECT F NUMBER" And Range("D11") > "0" Then
StorePath = "G:\Targets\" & SelectedFNumber & "\"
myFileName = StorePath & SelectedFNumber & " " & DateStr & ".xlsm
If Len(Dir(StorePath, vbDirectory)) = 0 Then
MkDir StorePath
End If
ActiveWorkbook.SaveAs Filename:=myFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Else
MsgBox "Select an F Number"
End If
End Sub
You basically need to add something like this:
Dim sShortcutLocation As String
sShortcutLocation = "C:\blah\workbook shortcut.lnk"
With CreateObject("WScript.Shell").CreateShortcut(sShortcutLocation)
.TargetPath = myFileName
.Description = "Shortcut to the file"
.Save
End With
changing the location to wherever you want.
i have a variable String named fileName and another variable named finalDoc
i am trying to compare both but it is not working. the program does not go in the if condition
Dim fileName As String
fileName = objFile.Name
finalDoc = cellValue & "-" & Range(sheetNo).Value & ".pdf"
//The fileName and finalDoc are getting values as expected
If finalDoc = fileName Then
'MsgBox finalDoc & " " & fileName
End If
the if condition is not working. it only works if i hardcode the value in fileName like
fileName ="abc.pdf"
any suggestions, i think this is a type issue String etc. Any help would be appreciated.
Using VBA of Excel 2013
You can't compare a string using "=". You must use the StrComp command that will return an integer depending on the outcome.
More information can be found Here
But here is an example that returns a match when comparing ABC.pdf and abc.pdf:
Sub test1()
Dim fileName1 As String
Dim fileName2 As String
Dim TestComp As Integer
fileName1 = "abc.pdf"
fileName2 = "ABC.pdf"
TestComp = StrComp(fileName1, fileName2, vbTextCompare)
If TestComp = 0 Then
MsgBox ("Match!")
Else
MsgBox (fileName1 & " and " & fileName2 & " are No Match. Outcome is " & TestComp)
End If
End Sub
All you now need to do is adjust this code to suit your needs.
Basically:
Dim fileName As String
Dim TestComp As Integer
fileName = objFile.Name
finalDoc = cellValue & "-" & Range(sheetNo).Value & ".pdf"
TestComp = StrComp(fileName,finalDoc,vbTextCompare)
If TestComp = 0 Then
//Insert code to run for a correct match
Else
//Insert code to run for incorrect match
End If
I found this bit of code and thought it might be good to use if I just need to pull one value from a closed sheet.
strInfoCell = "'" & strPath & "[" & strFile & "]Sheet1'!R3C3"
myvalue = ExecuteExcel4Macro(strInfoCell)
When I run this code I get a value for strinfocell of
'C:\Users\my.name\Desktop[QOS DGL stuff.xlsx]Sheet1'!R3C3
But when I run the code a dialogue pops up, showing desktop files with "QOS DGL suff" showing.
What's causing this, why is it not just pulling back the data as expected?
I know the path and file name are right, because if I copy them from the debug output and paste them in to start>>run then the correct sheet opens.
I know that Sheet1 (named: ACL), does have a value in cells(3,3)
It depends on how you use it. The open file dialog box is being showed to you because the "strPath" doesn't have a "" in the end ;)
Try this code.
Option Explicit
Sub Sample()
Dim wbPath As String, wbName As String
Dim wsName As String, cellRef As String
Dim Ret As String
'wbPath = "C:\Documents and Settings\Siddharth Rout\Desktop\"
wbPath = "C:\Users\my.name\Desktop\"
wbName = "QOS DGL stuff.xls"
wsName = "ACL"
cellRef = "C3"
Ret = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, -4150)
MsgBox ExecuteExcel4Macro(Ret)
End Sub
Similar application, but no hard coded paths as in the examples above. This function copies the value from another closed workbook, similar to the =INDIRECT() function, but not as sophisticated. This only returns the value...not a reference..so it cannot be used with further functions which require references (i.e.: VLOOKUP()). Paste this code into a new VBA module:
'Requires filename, sheetname as first argument and cell reference as second argument
'Usage: type in an excel cell -> =getvalue(A1,B1)
'Example of A1 -> C:\TEMP\[FILE1.XLS]SHEET1'
'Example of B1 -> B3
'This will fetch contents of cell (B3) located in (sheet1) of (c:\temp\file1.xls)
'Create a module and paste the code into the module (e.g. Module1, Module2)
Public xlapp As Object
Public Function getvalue(ByVal filename As String, ref As String) As Variant
' Retrieves a value from a closed workbook
Dim arg As String
Dim path As String
Dim file As String
filename = Trim(filename)
path = Mid(filename, 1, InStrRev(filename, "\"))
file = Mid(filename, InStr(1, filename, "[") + 1, InStr(1, filename, "]") - InStr(1, filename, "[") - 1)
If Dir(path & file) = "" Then
getvalue = "File Not Found"
Exit Function
End If
If xlapp Is Nothing Then
'Object must be created only once and not at each function call
Set xlapp = CreateObject("Excel.application")
End If
' Create the argument
arg = "'" & filename & "'!" & Range(ref).Range("A1").Address(, , xlR1C1)
'Execute an XLM macro
getvalue = xlapp.ExecuteExcel4Macro(arg)
End Function
Code above
strInfoCell = "'" & strPath & "[" & strFile & "]Sheet1'!R3C3"
myvalue = ExecuteExcel4Macro(strInfoCell)
Should read
strInfoCell = "'" & strPath & "[" & strFile & "]" & "Sheet1'!R3C3"
myvalue = ExecuteExcel4Macro(strInfoCell)
It is missing " & "
No need for a function
Cheers
Neil
Data = "'" & GetDirectory & "[" & GetFileName & "]" & Sheet & "'!" & Range(Address).Range("A1").Address(, , xlR1C1)
Address = "$C$3"
GetDirectory = "C:\Users\my.name\Desktop\"
GetFileName = "QOS DGL stuff.xlsx"
Sheet = "ACL"