Block of code handling looping through files in a directory:
Dim file As Variant
file = Dir(directory)
While (file <> "")
If (InStr(file, ".xlsx") > 0) And (InStr(file, "Percentage") = 0) And (InStr(file, aggregateFilename) = 0) Then
Call fight_dynamics_by_percentage_buckets(aggregateFilename, directory, file, folderToRunMacro, num_buckets)
End If
file = Dir
Wend
Earlier in my code, the user selects a directory storing a set of files. In my test directory, I have the following files:
Analyzed.11.14.383.Chamber1.xlsx
Analyzed.11.14.383.Chamber2.xlsx
Analyzed.11.14.383.Chamber3.xlsx
When I run the macro, the program extracts the filenames as:
Analyzed.11.14.383#494E5A0.xlsx
Analyzed.11.14.383#494E5A1.xlsx
Analyzed.11.14.383#494E5A2.xlsx
I have used this exact code before on previous directories, and have had no trouble extracting the correct filenames.
What's going on here?
I do not see any issue with your code and it is working fine for me as well. It may be a specific system of excel issue. You can use another option to get the same result and here are the codes for your reference. Have a good day
Set filesys = CreateObject("Scripting.FileSystemObject")
For Each sfile In filesys.GetFolder(directory).Files
file = filesys.GetFileName(sfile)
If (InStr(file, ".xlsx") > 0) And (InStr(file, "Percentage") = 0) And (InStr(file, aggregateFilename) = 0) Then
Call fight_dynamics_by_percentage_buckets(aggregateFilename, directory, file, folderToRunMacro, num_buckets)
End If
Next
Related
I'm running into issues trying to pull info from files stored in Sharepoint.
Namely, FileExists isn't working and Overwrite file doesn't seem to be working either.
There was a discussion here, but few answers -> posting this question again in hopes some things have changed
My code runs like this:
strFileExists = Dir(Filepath & Filename)
And returns: File path not found -> I checked the path and even opened a file and recorded the macro to make sure it was the same file path without issue, but it appears DIR() is the issue.
The business dept I'm working with is entirely switching over to Sharepoint so hoping there's a straightforward solution without setting up network shares or doing C/personal/OneDrive things
You can navigate and look for files on OneDrive like this
Sub check_File_Exists()
Dim path As String
Dim strType As String
Dim file As Variant
Dim yourFile As String
'replace uname with your user name
path = "C:\Users\uname\OneDrive\"
strType = "*txt"
yourFile = "test.txt"
file = Dir(path & strType)
Do While (file <> "")
If file = yourFile Then
Debug.Print ("File: " & file & " found!")
Exit Do
End If
file = Dir
Loop
End Sub
Hope it helps
I have a macro to copy some styles from a reference dotx file in the Template folder into the file I am editing. It works well if the file is purely in my local drive, but I receive a File not found error, code 4199, if the file being edited sits (locally) in OneDrive (business). Here is the code; the not-found file is in variable tpl, which points to an existing and valid file. If I run the same macro on the same file, but this time the file sits purely in a local folder, then there is no error.
I looked for similar cases online, but this seems to be an obscure occurrence. Thanks for any help!
'--start
Sub GetStylesfromTemplate_zToCStyleforReports()
Dim i, max As Integer
Dim Hdgs(11 + 1) As String
Dim tpl As String 'Complete path to template file
'Number of styles
max = 2
'List of styles
Hdgs(1) = "TOC 1": Hdgs(2) = "TOC 2"
' Environmental var plus end of template path and file name
tpl = Environ("APPDATA") & "\Microsoft\Templates\Report-ToC-Style-Here.dotx"
For i = 1 To max
Application.OrganizerCopy _
source:=tpl, _
Destination:=ActiveDocument, Name:=Hdgs(i), Object:=wdOrganizerObjectStyles
Next
End Sub
' -- End
This is a follow up to this question and great answer:
Copy files with progress bar
So I added the code from Siddharth Rout's answer and it does exactly what I want to happen with a minor exception. When I copy the files, I am looping through each file in the directory and copying it up as long as it is not *List.xml. Because I am replacing an existing library the 97% of the documents are pre-existing and I get prompted to replace existing documents each time.
Is there a way to get it to prompt me to choose to replace for all files? Do I need to reformat/structure the sequence of my code?
Function UploadToSharepoint(Folderpath As String, Foldername As String, Filenames() As String, SharepointLinks() As String) As Boolean
'upload file to sharepoint library based on the folder name
Dim SharePointLib As String
Dim LocalAddress As String
Dim DestinationAddress As String
Dim xCounter As Long
On Error GoTo loadFailed
Pickafolder:
Folderpath = FolderPick
Foldername = Left(Folderpath, Len(Folderpath) - 1)
Foldername = RIght(Foldername, Len(Foldername) - InStrRev(Foldername, "\"))
Select Case Foldername
Case "OPSS", "SSP", "OPSD", "MTOD", "SSD"
SharePointLib = "\\my.company.com\Subsite\" & Foldername & "\"
Case "West", "Eastern", "Northeastern", "Northwestern", "Head Office"
SharePointLib = "\\my.company.com\Subsite\NSP\" & Foldername & "\"
Case "NSP", "NSSP"
MsgBox "Pick the NSP regional sub folder: West, Eastern, Northeastern, Northwestern, Head Office"
GoTo Pickafolder
Case Else
MsgBox "Inappropriate directory to upload from. Please select one of the CPS download directories"
GoTo Pickafolder
End Select
Filenames = GetFilesDir(Folderpath)
ReDim SharepointLinks(LBound(Filenames) To UBound(Filenames))
For xCounter = LBound(Filenames) To UBound(Filenames)
LocalAddress = Folderpath & Filenames(xCounter)
DestinationAddress = SharePointLib & Filenames(xCounter)
'**********************************************************
Call VBCopyFolder(LocalAddress, DestinationAddress)
'**********************************************************
SharepointLinks(xCounter) = "#http:" & Replace(DestinationAddress, "\", "/") & "#"
Next xCounter
UploadToSharepoint = True
Exit Function
loadFailed:
UploadToSharepoint = False
End Function
And by the looks of things I am not excluding the file I was referring to earlier...must be doing that else where.
Update
Based on comment received at the linked question, the solution is to declare a public constant at the start:
Public Const FOF_NOCONFIRMATION As Long = &H10
and then in the copy procedure change the line of code to:
.fFlags = FOF_SIMPLEPROGRESS Or FOF_NOCONFIRMATION
Now, this does solve the problem of being constantly asked to confirm the replacement. I am very happy about this. The problem now is the progress window displays for the first file to be copied then disappears but fails to reappear for subsequent files. The remaining files still get copied and the prg carries on like it's supposed to. The whole point of the progress bar though was to let people know that "THINGS" were still happening in the background and now that is not happening. Is there something I need to adjust?
Update 2
After running my code and choosing a source directory on the network drive instead of the local computer, the copy window is popping up for every single file like I was expecting. I notice that sometimes the progress bar closes before reaching 100%. This leads me to believe that since the file sizes are so small that when it is copying from my local drive to sharepoint, the operation completes so fast that it does not have time to draw and update the progress window before its time to close it.
I am working with a VB script to read data from a text file. It works fine.
My challenge is that the file name changes everyday with date appended to it. The file is a text file and end with .TXT extension. Thus every time I have to rename the file to a fixed name that I have used in my script.
Is there a way to read a file from the current folder and with extension .TXT irespective of the name of the file. In the following code I am reading SNMP.TXT file, but the filename could be SNMP_20130415_xxxx.TXT one day and the SNMP_10130416_xxxx.TXT next day and so on.
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objInpoutFile = objFSO.OpenTextFile("D:\scripts\vb\FileHandleScript\SNMP.TXT",1)
Set objOutputFile = objFSO.OpenTextFile("D:\scripts\vb\FileHandleScript\snmp.csv",2,True)
An alternative without regular expression:
For Each f in objFSO.GetFolder("D:\scripts\vb\FileHandleScript").Files
name = LCase(f.Name)
If Left(name, 5) = "snmp_" And objFSO.GetExtensionName(name) = "txt" Then
'do stuff
End If
Next
Loop over the files in the folder, use a RegExp to find the file to process, exit the loop after having processed the file:
Dim reFiNa : Set reFiNa = New RegExp
reFiNa.IgnoreCase = True
reFiNa.Pattern = "^snmp_.+\.txt$" ' starting with snmp_, ending with .txt
For Each oFile in objFSO.GetFolder("D:\scripts\vb\FileHandleScript").Files
If reFiNa.Test(oFile.Name) Then
... process file ...
Exit For
End If
Next
I have this script but would like to enhance it that in the absence of the file on the C: copy the one from the R: Drive. Currently on check if file is there.
Currently this script will run on multiple files in a single folder \SCRIPTS.
As I repeat the statement for each of different file name (I do know the file names) A more economic way of checking all files in the the R:\SCRIPTS and comparing to the C:\SCRIPTS copying or overwriting file would be good if anyone has a snippet that might help
Const OverwriteExisting = TRUE
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objLocalFile = objFSO.GetFile("C:\SCRIPT\SCRIPTTEXT.txt")
dtmLocalDate = objLocalFile.DateLastModified
Set objServerFile = objFSO.GetFile("R:\SCRIPT\SCRIPTTEXT.txt")
dtmServerDate = objServerFile.DateLastModified
If dtmLocalDate < dtmServerDate Then
objFSO.CopyFile objServerFile.Path, objLocalFile.Path, OverwriteExisting
End If
using System.IO;
Dim ServerFolder As New IO.DirectoryInfo("R:\SCRIPT")
Dim LocalFolder As New IO.DirectoryInfo("C:\SCRIPT")
For Each ServerFile In ServerFolder.GetFiles
If IO.File.Exists(LocalFolder.FullName & "\" & ServerFile.Name) Then
Dim LocalFile As New IO.FileInfo(LocalFolder.FullName & "\" & ServerFile.Name)
If ServerFile.LastWriteTime > LocalFile.LastWriteTime Then
IO.File.Copy(ServerFile.FullName, LocalFile.FullName, True)
End If
Else
IO.File.Copy(ServerFile.FullName, LocalFolder.FullName & "\" & ServerFile.Name)
End If
Next