I am having troubles with NameSpace CopyHere function. I am trying to create a zip file containing a bunch of logs. I can create the zip file just fine, but when using the NameSpace.CopyHere, if I use a string or a variant containing a string, it won't write the file to the zip archive.
For example, I have a file located at P:\test2.txt .
If I use those lines :
objApp.Namespace(sZipArchive).CopyHere sFile
objApp.Namespace(sZipArchive).CopyHere vLogs(i)
where sFile = vLogs(i) = "P:\test2.txt
the file test2.txt won't be copied in the zip archive.
However, if I use this line :
objApp.Namespace(sZipArchive).CopyHere "P:\test2.txt"
Then, the file gets copied in the zip file.
If I put a check to see if the sFile or vLog(i) is = "P:\test2.txt", I can see that they are the same thing.
Is there something I am missing here on why the first 2 lines don't work, but the third one does?
Thank you for your time.
Full sub :
Private Sub BtnSaveToZip_Click()
Dim bEndRow, bTest As Boolean
Dim iRow, iCount As Integer
Dim sZipArchive, sDate, sFolderExists, sFile As String
Dim vLogs, vFilename As Variant
Dim objApp As Object
sDate = Date
sDate = Replace(sDate, "/", "") ' set date format to DDMMYYYY instead of DD/MM/YYYY
sZipArchive = LblLogArchive + "\" + sDate
sFolderExists = Dir(sZipArchive)
If sFolderExists = "" Then
CreateDir (sZipArchive) ' if the subfolder with the date does not exists, create it
End If
sZipArchive = sZipArchive + "\" + wsContacts.Range("B7").Value + " Logs_" + sDate + ".zip"
'Check if file is open
If FileLocked(sZipArchive) Then
MsgBox sZipArchive + " already open. Please close the archive."
Exit Sub
End If
'Creating the zip file from Ron de Bruin
NewZip (sZipArchive)
'filling the zip file
Set objApp = CreateObject("Shell.Application")
bEndRow = False
iRow = gFirstData
Do While bEndRow = False
If Not IsEmpty(wsLogs.Cells(iRow, gTestCase).Value) Then
If Not IsEmpty(wsLogs.Cells(iRow, gLog).Value) Then
vLogs = Split(wsLogs.Cells(iRow, gLog).Value, ";")
For i = 0 To UBound(vLogs) - 1
sFile = vLogs(i) ' Debug only
If sFile = "P:\test2.txt" Then 'Debug only
objApp.Namespace(sZipArchive).CopyHere vLogs(i) ' if I put "P:\test2.txt", it works correctly
'Keep script waiting 5s for debug purpose
Application.Wait (Now + TimeValue("00:00:05"))
End If
Next
End If
iRow = iRow + 1
Else
bEndRow = True
End If
Loop
MsgBox "Zip successfully created"
Set objApp = Nothing
End Sub
If this works
objApp.Namespace(sZipArchive).CopyHere "P:\test2.txt"
and sFile and vLogs(i) appears to be the same as P:\test2.txt then I believe it could be a leading or trailing space problem. Try this
objApp.Namespace(sZipArchive).CopyHere Trim(sFile)
or
objApp.Namespace(sZipArchive).CopyHere Trim(vLogs(i))
The other way to check if sFile and vLogs(i) contains a valid path is by using DIR
One more way of debugging is to step through your code and then type this in the Immediate window
?=vLogs(i)="P:\test2.txt"
?=sFile="P:\test2.txt"
You should get a true in both cases. If you don't then there is your problem :)
Related
As we know, we use Find() method to find whether a string or any Microsoft Excel data type exists in an excel.
(Usually we do it on set of data)
I want to know if any such method available when we loop through folder(of files) using Dir function.
Situation:
I have an excel - 'FileNames.xlsx' in which 'Sheet1' has names of files having extensions .pdf/.jpg/.jpeg/.xls/.xlsx/.png./.txt/.docx/ .rtf in column A.
I have a folder named 'Folder' which has most(or all) of the files from 'FileNames.xlsx'.
I have to check whether all the file-names mentioned in the 'FileNames.xlsx' exist in 'Folder'.
For this I have written the below VBScript(.vbs):
strMessage =Inputbox("Enter No. of Files in Folder","Input Required")
set xlinput = createobject("excel.application")
set wb123 =xlinput.workbooks.Open("E:\FileNames.xlsx")
set sh1 =wb123.worksheets("Sheet1")
For i = 2 to strMessage +1
namei = sh1.cells(i,1).value
yesi = "E:\Folder"+ namei +
If namei <> yesi Then
sh1.cells(i,1).Interior.Color = vbRed
Else
End If
Next
msgbox "Success"
xlinput.quit
As I wasn't able to get the required Output I tried it recording a small Excel VBA Macro. (Changed FileNames.xlsx to FileNames.xlsm)
Sub LoopThroughFiles()
Dim lastRow As Long
lastRow = Sheets("Sheet1").UsedRange.Rows.Count
Dim MyFolder As String
Dim filename As Range
Dim MyFile As String
MyFolder = "E:\Folder"
For Each filename In Worksheets("Sheet1").Range("A2A:" & lastRow)
MyFile = Dir(MyFolder & "\*.xlsx")
'Here I actually need to pass all file extensions to Dir
Do While MyFile <> ""
If filename = MyFile Then
'Do Nothing
Else
filename.Interior.Color = vbRed
MyFile = Dir
Next
End Sub
The above is a failed attempt.
I thought of trying it with method similar to Find()
Sub LoopThroughFiles()
Dim lastRow As Long
'Dim LastFile As Long
'Is there need of it (LastFile variable)? I kept this variable
'to save (prior known) count of files in folder.
lastRow = Sheets("Sheet1").UsedRange.Rows.Count
'LastFile = 'Pass count of Files in folder to this variable.
Dim fileName As Range
For Each fileName In Worksheets("Sheet1").Range("A2:A" & lastRow)
Dim rngFnder As Range
On Error Resume Next
'Error at below line.
Set rngFnder = Dir("E:\Folder\").Find(filename)
'This line gives me error 'Invalid Qualifier'
'I am trying to use method similar to Find()
If rngFnder Is Nothing Then
filename.Interior.Color = vbRed
End If
Next
End Sub
But, I couldn't achieve the result. Can anyone tell me is there any such function available to 'Find' whether all filenames in an excel exist in a folder after looping through folder using Dir?
As per my knowledge, Dir function works with only one file extension at a time.
Is it possible to use Dir function for multiple file extensions at a time?
Expected Output:
Assume I have 8 filenames in 'FileNames(.xlsx/.xlsm)'. Out of which Arabella.pdf and Clover.png are not found in 'Folder', Then I want to color cells for these filenames in red background in excel as in below image.
Sub LoopThroughFiles()
Dim lastRow As Long
lastRow = Sheets("Sheet1").UsedRange.Rows.Count
Dim MyFolder As String
Dim filename As Range
Dim MyFile As String
MyFolder = "E:\Folder"
For Each filename In Worksheets("Sheet1").Range("A2:A" & lastRow)
MyFile = MyFolder & "\" & filename
If Not FileExists(MyFile) Then
filename.Interior.Color = vbRed
End If
Next
End Sub
Public Function FileExists(strFullpathName As String) As Boolean
If Dir(strFullpathName) <> "" Then
FileExists = True
Else
FileExists = False
End If
End Function
You can output a list of the files that are contained in the folder. I found a really helpful tutorial on that here: http://software-solutions-online.com/2014/03/05/list-files-and-folders-in-a-directory/#Jump1
If you then loop through both the original and the output lists and look for a match. Easiest is to first colour them all red, and un-colour the matches. Else you would need an additional if-statement that states: When you reach the last element in the original list, and no match has been found, then colour red.
Edit: For continuity's sake I copied the code bits of the link I mentioned above:
Getting all file names form within 1 folder:
Sub Example1()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("D:StuffFreelancesWebsiteBlogArraysPics")
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
'print file path
Cells(i + 1, 2) = objFile.Path
i = i + 1
Next objFile
End Sub
I am a new to VBA. My issue is that I have a file that will be updated it into a specific folder by different users. Now everytime a user updates the file, the name of the file might not be the samefolder. However, I can narrow it down using specific keywords. I have been able to search for a file using a keyword but not multiple keywords. Please can you point me in the right direction on how I can use multiple keywords to find a file in a folder? Is it possible to write code that will work like the below?
Sub Start_countries()
Dim keyword, pathname, filename As String
pathname = "C:\XYZ\"
keyword = "lol" Or "rofl" Or "lmfao" Or "rotfl"
filename = Dir(pathname & "*.xls*")
Do While filename <> "*.xls*"
If LCase(filename) Like "*" & keyword & "*" Then
Set wb = Workbooks.Open(pathname & filename)
Find_count_sum_in_file filename
wb.Close SaveChanges:=True
Else
msgbox = "No file Found"
End If
Loop
End Sub
Try the following (adapted following your comment):
Private Const MAX_KWD = 5 ' use a constant to make sure everyone uses the same value
Sub Start_countries()
Dim keyword(1 To MAX_KWD), pathname As String
'Keywords for first file search
keyword(1) = "lol"
keyword(2) = "rofl"
keyword(3) = "lmfao"
keyword(4) = "rotfl"
pathname = "C:\XYZ1\"
search_for_files keyword(), pathname
'Keywords for second file search
keyword(1) = "omg"
keyword(2) = "fyi"
keyword(3) = "ok"
keyword(4) = "brb"
pathname = "C:\XYZ2\"
search_for_files keyword(), pathname
End Sub
Sub search_for_files(keyword(), pathname)
Dim filename As String, s As String
Dim i As Integer
filename = Dir(pathname & "*.xls*")
Do While InStr(filename, ".xls") <> 0
s = LCase(filename)
For i = 1 To MAX_KWD
If (InStr(s, keyword(i)) > 0) Then Exit For ' found!
Next i
If (i <= MAX_KWD) Then
Set WB = Workbooks.Open(pathname & filename)
Find_count_sum_in_file filename
WB.Close SaveChanges:=True
Else
MsgBox "No file Found"
End If
filename = Dir()
Loop
End Sub
Note that in Dim pathname, filename, s As String only s is declared as String; all others are declared as Variant (the As String does not apply to all variables declared on the line).
Note also that in your While filename <> "*.xls*" the test will be exact, i.e. it will look also for asterisks (*) in filename.
I'm trying to figure out a line of code to open a file.
The path is constant, that is
"H:\silly\goose\*filename.xlsm*"
However, this file name will change each time I try to run this macro. This is because I will be using this macro to automate a report which I run weekly. Each report is saved with the date in the title and all reports are kept in the same folder, meaning I can't just start naming them all the same.
Examples:
H:\silly\goose\Report 06-03-15.xlsm
H:\silly\goose\Report 05-27-15.xlsm
The only helping piece of information is that this report is to be run every Wednesday. Therefore, each filename will have a difference of 7 days. I don't know if there is anything I can do with the Date method here, though.
What you need to do is re-construct your file name first.
Const fpath As String = "H:\silly\goose\" ' your fixed folder
Dim fname As String
' Below gives you the Wednesday of the week
fname = Format(Date - (Weekday(Date) - 1) + 3, "mm-dd-yy") ' returns 06-03-15 if run today
fname = "Report " & fname & ".xlsm" ' returns Report 06-03-15.xlsm
fname = fpath & fname ' returns H:\silly\goose\Report 06-03-15.xlsm
Then execute opening of the file:
Dim wb As Workbook
Set wb = Workbooks.Open(fname)
If wb Is Nothing Then MsgBox "File does not exist": Exit Sub
' Rest of your code goes here which works on wb Object
This reference has this function:
Function GetFileList(FileSpec As String) As Variant
' Returns an array of filenames that match FileSpec
' If no matching files are found, it returns False
Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String
On Error GoTo NoFilesFound
FileCount = 0
FileName = Dir(FileSpec)
If FileName = "" Then GoTo NoFilesFound
' Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount) = FileName
FileName = Dir()
Loop
GetFileList = FileArray
Exit Function
' Error handler
NoFilesFound:
GetFileList = False
End Function
Now you can do:
p = "H:\silly\goose\*.xlsm"
x = GetFileList(p)
And get the file you want
This code uses Dir to get sub-dirs. Each sub-dir needs to have its xls files processed. After it finishes processing the first batch of xls, I get invalid procedure call or argument. I am guessing when I pass dirLook to the function it creates a copy? Please assist. I need to move on to the next sub-dir.
dirLook = dir(strDir, vbDirectory)
Do While dirLook <> ""
If dirLook <> "." And dirLook <> ".." Then
If (GetAttr(strDir & adir) And vbDirectory) = vbDirectory Then
'Perform action on folder here
loopXls (dirLook)
Debug.Print dirLook
End If
End If
dirLook = dir
Loop
loopXls:
Function loopXls(dirStr As String)
Dim count As Integer
Dim strFilename As String
Dim strPath As String
Dim wbkTemp As Workbook
strPath = "C:\Users\pmevi\Documents\L7\L7_Master_Book\Input\" & dirStr & "\"
strFilename = dir(strPath & "*.xls")
Do While Len(strFilename) > 0
Set wbkTemp = Workbooks.Open(strPath & strFilename)
'
' do your code with the workbook
'
' save and close it
wbkTemp.Close True
count = count + 1
strFilename = dir
Loop
Debug.Print (count)
End Function
EDIT2
I am attemping to load each dir into an array, but for some reason when I loop through array I only see 3 folders instead of 5.
Dim dirs(5) As String
Dim i As Integer
Dim endNum As Integer
endNum = 4
dirLook = dir(strDir, vbDirectory)
For i = 0 To endNum
dirs(i) = dirLook
dirLook = dir
Next i
For i = 0 To endNum
Debug.Print (dirs(i))
Next i
output:
3-10-14
3-11-14
3-12-14
expected:
3-10-14
3-11-14
3-12-14
3-13-14
3-14-14
Edit3
Found issue to array. 2 indexes are used for "." and ".."
It's not exactly clear from the code, but if the code above is in the loopXls method, making this a recursive function then the problem is that you cannot use the Dir function recursively, as stated here, towards the bottom.
The answer here include shows an example class for recursing with the Dir function.
I need to open a file whose full filename I do not know.
I know the file name is something like.
filename*esy
I know definitely that there's only one occurrence of this file in the given directory.
filename*esy is already a "shell ready" wildcard & if thats alway the case you can simply;
const SOME_PATH as string = "c:\rootdir\"
...
Dim file As String
file = Dir$(SOME_PATH & "filename*esy" & ".*")
If (Len(file) > 0) Then
MsgBox "found " & file
End If
Just call (or loop until empty) file = Dir$() to get the next match.
There is an Application.FileSearch you can use (see below). You could use that to search for the files that match your pattern. This information taken from here.
Sub App_FileSearch_Example()
With Application.FileSearch
.NewSearch
.LookIn = "c:\some_folder\"
.FileName = "filename*esy"
If .Execute(SortBy:=msoSortByLastModified, SortOrder:=msoSortOrderDescending) > 0 Then
For i1 = 1 To .FoundFiles.Count
' do something with matched file(s)
Next i1
End If
End With
End Sub
If InStr(sFilename, "filename") > 0 and InStr(sFilename, "esy") > 0 Then
'do somthing
end if
Or you can use RegEx
Dim RE As Object, REMatches As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.MultiLine = False
.Global = False
.IgnoreCase = True
.Pattern = "filename(.*)esy"
End With
Set REMatches = RE.Execute(sFilename)
REMatches(0) 'find match
I was trying this question as a function. This is the solution that ended up working for me.
Function fileName(path As String, sName As String, ext As String) As Variant
'path is Full path from root. Can also use path = ActiveWorkbook.path & "\"
'sName is the string to search. ? and * are wildcards. ? is for single char
'example sName = "book?" or sName ="March_*_2014*"
'ext is file extention ie .pdf .xlsm .xls? .j*
Dim file As Variant 'Store the next result of Dir
Dim fname() As String 'Dynamic Array for result set
ReDim fname(0 To 0)
Dim i As Integer ' Counter
i = 0
' Use dir to search and store first result
fname(i) = path & Dir(path & "\" & sName & ext)
i = i + 1
'Load next result
file = Dir
While file <> "" 'While a file is found store that file in the array
ReDim Preserve fname(0 To i) As String
fname(i) = path & file
file = Dir
Wend
fileName = Application.Transpose(fname) 'Print out array
End Function
This works for me as a single or array function.
If you know that no other file contains "filename" and "esy" in that order then you can simply use
Workbooks.Open Filename:= "Filepath\filename*esy.*"
Or if you know the number of missing characters then (assuming 4 characters unknown)
Workbooks.Open Filename:= "Filepath\filename????esy.*"
I use this method to run code on files which are date & timestamped to ignore the timestamp part.