Below is the code so far
I often times have to check if a Purchase Order has been saved in a directory, there could be hundreds of purchase orders listed in Excel.
As the Workbook changes, so often does the filepath.
As such, I would like to make a function that asks for a cell value that contains a string for the filepath, and then a a cell for the PO #.
I'm a little stumped on how best to past information from the Excel sheet. I need a cell reference for the filepath to the directory, and a cell reference for the PO #.
I've been able to make this work with a subroutine, that is what is posted below. This is the third VBA Program I've worked on, please let me know if there is more legwork I should do before posting this:
Dim directory As String
Dim TempfileName As String
Dim i As Long
Dim x As Long
Sub Check_PO()
x = 2
Application.ScreenUpdating = False
For x = 2 To 673
While Cells(x, 14) = 0
x = x + 1
Wend
i = Cells(x, 14)
TempfileName = "\\network\file\name\here\" & "*" & i & "*.pdf"
directory = Dir(TempfileName, vbNormal)
While directory <> ""
Cells(x, 18) = "Matched"
directory = Dir
Wend
Next x
End Sub
Here's a simple UDF:
Public Function HaveReport(fPath As String, fileName As String)
HaveReport = IIf(Dir(fPath & fileName, vbNormal) <> "", _
"Matched", "Not Matched")
End Function
Usage:
Related
My code gives me error from
If Dir(Pth, vbArchive) <> vbNullString Then
I havent been able to find the error - Can someone help me what is wrong with the code? Is it supposed to say USERPROFILE, or am i supposed to write something else?
Sub Opgave8()
Dim sh As Worksheet
Dim Pth As String
Application.ScreenUpdating = False
' Create default desktop path using windows user id
user_id = Environ$("USERPROFILE")
' Create full path
file_name$ = "\AdminExport.csv"
Pth = Environ$("USERPROFILE") & "\Desktop\" & FileName
Set sh = Sheets.Add
For i = 2 To 18288
If Left(Worksheets("Base").Cells(i, 12), 6) = "262015" Then
sh.Cells(i, 2) = Worksheets("Base").Cells(i, 4)
End If
Next i
sh.Move
If Dir(Pth, vbArchive) <> vbNullString Then
overwrite_question = MsgBox("File already exist, do you want to overwrite it?", vbYesNo)
End If
If overwrite_question = vbYes Then
With ActiveWorkbook
.SaveAs FileName:=Pth, FileFormat:=xlCSV
.Close False
End With
End If
Application.ScreenUpdating = True
End Sub
Function UniqueRandDigits(x As Long) As String
Dim i As Long
Dim n As Integer
Dim s As String
Do
n = Int(Rnd() * 10)
If InStr(s, n) = 0 Then
s = s & n
i = i + 1
End If
Loop Until i = x + 1
UniqueRandDigits = s
End Function
There are a few issues in your code. I don't understand why you are getting an error message, but if you fix your issues, you are in a better position of finding the main problem.
Put Option Explicit at the top. If you do that, you will not do mistakes like setting the variable file_name$ but reading from the variable FileName.
You are building a path with double backslashes. Perhaps not a big thing and it'll probably work. Add a Debug.Print Pth just before your troublesome If. Press Ctrl-G to show the debug pane and study the output. Does the printed file path exist?
Don't use vbNullString. Test with abc <> "" instead.
I was wondering whether there is a (built in/simple) option to reference/connect/link to a workbook that has a variable name?
My xy-problem is, I have workbook b v45.xlsm and wish to export data to workbook a v34.xlsm where the version numbers vary. So I was wondering if there is a sub-ID for each workbook, to which excel can refence independent of the name, automatically picking the most recent version in that folder.
Of course the simple solution is to pick the most recently modified excel file in the folderpath containing the string "a v", assuming an identical folderpath, but I was curious if there was a more convential/integrated option for this.
Kind regards.
(For future people looking at this issue, here is my manual solution:)
Sub find_planner_name()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim string_object(0 To 2) As String 'saving the filenames as strings
Dim count As Integer 'counting nr of files encountered
Dim save_version_number(0 To 1) As Long
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(ThisWorkbook.Path)
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'print file name
'Cells(i + 1, 1) = objFile.name
count = count + 1
ReDim version_number(0 To count) As Long
string_object(0) = ""
string_object(1) = ""
string_object(2) = ""
string_object(0) = objFile.name
If Right(string_object(0), 5) = ".xlsm" Or Right(string_object(0), 5) = ".xlsb" Then
If Left(string_object(0), 10) = " planner v" Or Left(string_object(0), 10) = " planner v" Then
string_object(1) = Right(string_object(0), Len(string_object(0)) - 10)
MsgBox (string_object(1))
Do While IsNumeric(Left(string_object(1), 1)) = True
If IsNumeric(Left(string_object(1), 1)) = True Then
string_object(2) = string_object(2) & Left(string_object(1), 1)
string_object(1) = Right(string_object(1), Len(string_object(1)) - 1)
End If
Loop
If version_number(count) < string_object(2) And string_object(2) > 0 Then
version_number(count) = string_object(2)
MsgBox (version_number(count))
save_version_number(0) = version_number(count)
save_version_number(1) = count
End If
End If
End If
i = i + 1
Next objFile
count = save_version_number(1) 'rewrite maxima back
version_number(count) = save_version_number(0) 'rewrite maxima back
'MsgBox ("done " & version_number(count))
Dim myMax As Long
Dim count_results As Long
For count_results = LBound(version_number, 1) To UBound(version_number, 1)
If version_number(count_results) > myMax Then
myMax = version_number(count_results)
Findmax = count_results
'MsgBox (version_number(count_results))
End If
'MsgBox (version_number(count_results) & " and count_results = " & count_results)
Next count_results
'the name of the planner =
name_planner = " planner v" & version_number(Findmax) & ".xlsm"
' check if xlsm or xlsb
'MsgBox (name_planner)
If Dir(ThisWorkbook.Path & "\" & name_planner) <> "" Then
MsgBox ("File exists. and name is " & name_planner)
Else
name_planner = " planner v" & version_number(Findmax) & ".xlsb"
End If
End Sub
It should be more reliable to parse filenames looking at the version numbers rather than looking at the most recently modified file. Loop through all of them checking the filename with something like:
strFile = Dir(DirectoryPath)
Do while strFile <> ""
'Code here to parse strFile for intNewVersionNumber
if intNewVersionNumber > intVersionNumber then intVersionNumber = intNewVersionNumber
strFile = Dir
Loop
strFile = 'Code here to reconstruct filename from intVersionNumber
From your question, I think this might actually be necessary, even though there may be a couple of ways of adding/checking metadata on Excel files.
When you say the workbook name changes, it is literally the exact same file being renamed through Windows Explorer, or do you have multiple versions in the same folder created when you use Save As...? The issue of "automatically picking the most recent version" suggests that there are new versions being created in the same folder. If so, it means that you're actually changing which workbook you're linking to, so any kind of link to a file isn't going to work anyway. Also, even if you put in a sub-ID, each version will still have that same sub-ID. While this can still identify the files that are different versions of the same file, you still have to loop through all of those files looking for the latest version. A sub-ID would help if the filename is changing entirely, but doesn't remove the need to search through the different versions. So, if you can keep a consistent filename with only the version number changing, you'll be able to implement the simplest solution possible.
Here you have some information regarding my Excel file so you know better my worksheet layout:
it is a normal excel sheet (.xlsx) which starts at row 5 and has many different entries for a table.
Some of this entries are automatically calculated from a function which uses values from cells from the same row.
The document goal is to be a template, so the number of rows containing information may vary depending who is using the template.
Even though the number of rows containing information may vary the functions have to be present at all cells in a column, so whenever someone places a new entry to the table it is automatically calculated.
The formulas are all of them like this: " = if ( #cellvalue <> ""# ; #dosomething# ; #""#) ", which mainly places an empty string if no value is present in a cell, and does someting else if a value is entered.
The template will be cell protected, so only some cells would be able to be modified.
During the last days I've been trying to implement a Button for excel which does the following things on click:
Detect which rows contain table entries, but discarting the rows which contain no manually entered values and may only contain the function stated on the previous paragraph. The table always start at raw 5 but might end at row 50 or 60 or whenever the person who uses it stops to manually enter new entries to the table. It is possible that only the row 5 contains information, but it can never happen that any entry is present in the table.
Create a new ".csv" file, containing only the previously selected rows, on the same folder as the ".xlsx" file which is being used as a template. The ".csv" file name must be the same as the ".xlsx" file, but appending some information present in some specific cells (for example information present in cell A1, B1, A3, C3). The information to be appended will always be string text which will never come from a function output but from manually entered by the keypad. It could be that some of this cells contain no information (empty strings such as: "").
The button action should directly save the file in the same directory where the template is without opening a dialog to save the file. The button should also prompt a dialog in case the name being used for the ".csv" file already exists as a "filename.csv" file in the same folder. This prompted dialog should ask if you would like to overwrite the existing file with the same name with the new one.
Written without Excel on my current PC so you'll need to tinker a bit but something like this:
' Rows that contain entries:
' assuming data is in column A (i.e. col 1)
Dim rowHolderArray() as long
Dim lastRow as long
lastRow = range("A65000").End(xlUp).Row
Redim rowHolderArray(lastRow)
For x = 1 to lastRow
If cells(x,1) <> "" then rowHolderArray(x) = x
next x
2) to populate the csv, create it using the AddWorkbook method then do something like:
Dim rowCounter as long
rowCounter = 1
For x = 0 to UBound(rowHolderArray) - 1
If rowHolderArray(x) <> "" then
cells(rowCounter, 1) = rowHolderArray(x)
rowCounter = rowCounter + 1
End if
Next x
3) To save the book use Application.ActiveWorkbook.Path & "/" & yourWorkBook.name & ".xlsx"
Thanks to everyone, finally I could implement what I wanted. Here you have my example code so you can check it:
Private Sub CommandButton1_Click()
Dim i As Boolean
Dim j As Integer
Dim currentworkbook As String
Dim currentpath As String
Dim csvfilename As String
Dim contentrange As Range
Dim researchername As String
Dim projectname As String
Dim aditional_info As String
Dim year As String
Dim month As String
Dim day As String
Dim hour As String
Dim minute As String
Dim WB As Workbook
Application.DisplayAlerts = False
' Calculate which was the last row with information
i = True
j = 12
While i
j = j + 1
If (Application.Cells(j, 2) = "") Then
i = False
j = j - 1
End If
Wend
' Copy the information I wanted to save in a .csv file
Application.Range(Application.Cells(12, 1), Application.Cells(j, 16)).Copy
' Create some variables to manage the path ant some filenames
currentworkbook = Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5)
currentpath = Application.ActiveWorkbook.Path
csvfilename = currentworkbook & "_"
researchername = Application.Cells(1, 2)
projectname = Application.Cells(3, 2)
aditional_info = Application.Cells(5, 2)
year = Format(Now(), "yy")
month = Format(Now(), "MM")
day = Format(Now(), "dd")
hour = Format(Now(), "Hh")
minute = Format(Now(), "Nn")
' Create a new workbook which will be filled with the information copied and then saved as a .csv file.
Set WB = Workbooks.Add
With WB
.Title = "mytitle"
.Subject = "Mysubject"
.Sheets(1).Select
ActiveSheet.Paste
.SaveAs currentpath & "\" & csvfilename & "_" & year & "-" & month & "-" & day & "_" & hour & "h" & minute & "m_" & projectname & "_" & researchername & "_" & aditional_info, xlCSV
.Close
End With
Application.DisplayAlerts = True
End Sub
I have the following excel vba code to get the txt files from a folder and put them into excel.
Sub testfilelistfromfolder()
Dim varDirectory As Variant
Dim flag As Boolean
Dim i As Integer
Dim strDirectory As String
strDirectory = Application.ActiveWorkbook.Path & "\"
i = 1
flag = True
varDirectory = Dir(strDirectory & "*.txt", vbNormal)
Range("B3:B82").Select
Selection.ClearContents
While flag = True
If varDirectory = "" Then
flag = False
Else
Cells(i + 2, 2) = varDirectory
varDirectory = Dir
i = i + 1
End If
Wend
End Sub
so my question is:
Is there a way to list the txt filenames without the .txt extension?
or should I add a line to trim the names?
something like this:
variable = Left(Sheet1.[A1],InStr(Sheet1.[A1],".")-1)
and if so, how should i adapt this to my original code, where should i put it? is it also possible to replace Sheet1 with the active sheet parameter?How?
thank you very much.
I'd tackle is thusly
Else
sStr = InStr(varDirectory, ".txt")
Cells(i + 2, 2) = Left(varDirectory, sStr - 1)
flNAME = Left(Cells(1, 1).Value,Len(Cells(1, 1).Value)-4)
This grabs the Value of the cell indicated and trims the last for characters off. Obviously if it is not a dot with a three letter extension you will have extra characters. For example, .XLSX would leave the dot.
The code is going to assume that you means the cells of the active sheet. If you want to get data from a different sheet then you need to add code to select the new sheet.
I am not sure what you are trying to use if for so it is hard to say where you will need it in your code at.
In the code below I could wrote a code to display filenames from a folder. The problem is now that I should display them in the correct Row. For now they are displayed in random sequence and that is not the purpose.
In column "A" the filenames to search for are called with similar name format PBM12.T5.103.
The actual filename to find is called with similar name format 1_29_PBM_12_T5__103.
I have to find a solution to compare "only" the Fat marked letters and numbers like displayed here above, without . or _
As you will see PBM12T5103 is returning in both namestructures.
Please don't try fixed length counts because the filenames are dynamic and the amount of letters are variable. The comparison of the SUBSTITUTED length of column "A" ( PBM12T5103) is the key to comparison but I can not handle to establish this comparison.
When the filename in column "A" has been found, in column "C" the full filename of found file has to be displayed as the original format 1_29_PBM_12_T5__103
Maybe a solution can be found when extra columns can be made to establish the comparison?
In Excel I could approach a solution, but this will not work automized like it should do.
I made the LEN(count dynamic), but this is still no solution to display the full filenames in the required row...
Hopefully somebody can help me out ..
Option Explicit
Sub fileNames_in_folder()
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Dim fldpath
Dim fld As Object, fil As Object, fso As Object, j As Long
fldpath = "C:\"
On Error Resume Next
Thisworkbook.Sheets("1").Activate
'start count row
j = 11
Set fso = CreateObject("scripting.filesystemobject")
Set fld = fso.getfolder(fldpath)
For Each fil In fld.Files
'here I have to add an IF statement in order to compare the filenames written in column "A" with files from folderPath C:\"
'When the correct files is found it should be displayed in column "C"
If
then
Cells(j, 34).Value = fso.GetBaseName(fil.path)
End If
'count behaviour
j = j + 1
Next
Columns("AH").AutoFit
End Sub
I will suggest you different way of getting file names. Instead of FileSystemObject let's use simple Dir function which allows to check the pattern of file name.
1) Files in my testing folder are as follows
2) I assumed that file pattern is as follows:
XXXY.Z.W
where:
XXX > 3 letters text
Y > any length number/text
Z > any length number/text
W > any length number/text
3) The code of subroutine is placed in 2013-06-01...xlsm file which you could see in the pic above (the same folder where your files are). Code is as follows (change where appropriate):
Sub solution()
Dim j As Long, LastRow As Long
Dim fldPath
'your path below
fldPath = ThisWorkbook.Path
ChDir fldPath
Dim arrPattern As Variant
Dim filName As String
For j = 1 To Range("A1").End(xlDown).Row
arrPattern = Split(Cells(j, "A"), ".")
'I suggest to use different way of checking _
pattern of file name. Pattern rules:
'*YYY*XX*Z*W*
filName = Dir("*" & Left(arrPattern(0), 3) & "*" & _
Mid(arrPattern(0), 4) & "*" & _
arrPattern(1) & "*" & _
arrPattern(2) & "*")
If Len(filName) > 0 Then
Cells(j, "B") = filName
Else
Cells(j, "B") = "not found"
End If
Next j
End Sub
4) results are presented in the picture below: