I'm trying to create a script that will open the latest folder in a directory.
The name of the folder will be different each month (01-Jan, 02-Feb e.t.c). The below seems to find the latest folder, but I get error File not found when I add in Shell "explorer.exe" & "" & strFullFldrPath, vbNormalFocus to open the folder.
This is what I have so far.
Sub GetLatestFolder()
Dim fso As FileSystemObject
Dim fldrRoot As Folder
Dim SubFld As Folder
Dim strFolderName As String
Dim strFullFldrPath As String
Set fso = New FileSystemObject
Set fldrRoot = fso.GetFolder("\\Hbeu.adroot.hsbc\dfsroot\GB002\RRU\DTCC EU Reports\ETD\")
For Each SubFld In fldrRoot.SubFolders
strFolderName = SubFld.Name
strFullFldrPath = fldrRoot & "\" & SubFld.Name
Shell "explorer.exe" & "" & strFullFldrPath, vbNormalFocus
Exit For
Next SubFld
End Sub
You try to run "explorer.exeC:\WHATEVER" i.e. your missing a space between the executable and its argument.
Quotes are a good idea to accommodate paths with spaces.
Shell "explorer.exe" & " """ & strFullFldrPath & """, vbNormalFocus
What you have does not guarantee the latest folder is always first, you should apply some logic based on the name or load all directories and sort.
Related
Please go through my code, correct me where I am wrong, files are not moving from folder to folder.
Option Explicit
Sub MoveFiles()
Dim FSO As Object
Dim FromDir As String
Dim ToDir As String
Dim FExtension As String
Dim Fnames As String
FromDir = "C:\Users\B\Source Folder"
ToDir = "C:\Users\B\Destination Folder"
FExtension = "*.*"
Fnames = Dir(FromDir & FExtension)
If Len(Fnames) = 0 Then
MsgBox "No files or Files already moved" & FromDir
Exit Sub
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.MoveFile Source:=FromDir & FExtension, Destination:=ToDir
End Sub
Problem
You are missing a \ at the end of your FromDir which will separate the path from your filenames.
For your info: & is not really combining path and filename, but just concatenating two strings, so it never adds the \ itself.
Correction possibility 1
You can add it to the definition of FromDir:
FromDir = "C:\Users\B\Source Folder\"
Correction possibility 2
Add it to these lines of code dynamically:
Fnames = Dir(FromDir & "\" & FExtension)
FSO.MoveFile Source:=FromDir & "\" & FExtension, Destination:=ToDir
Another remark
You should also separate FromDir from the error text, like this:
MsgBox "No files or Files already moved: " & FromDir
I'm attempting to create a folder from a form in MS Access. I need to have the ability to create a new folder for each form entry. I'm a novice VBA programmer, but have learned a lot through searching and testing techniques online. Here is the code:
Private Sub Create_File_Folder_Click()
Engine.SetFocus
If Dir("C:\Users\ndemos\Documents\Test\" & TimeDateTeam.Value, vbDirectory) = "" Then
MkDir ("C:\Users\ndemos\Documents\Test\" & TimeDateTeam.Value)
Const strParent = "C:\Users\ndemos\Desktop\Test\"
Dim strTimeDateTeam As String
Dim strFolder As String
Dim fso As Object
strStudentID = Me.TimeDateTeam
strFolder = strParent & strStudentID
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(strFolder) Then
MsgBox "Specified folder already exists.", vbInformation, "File Folder"
Exit Sub
Else
fso.CreateFolder strFolder
End If
Shell "explorer.exe " & strFolder, vbNormalFocus
End If
End Sub
I am running into a run-time error 76 "path not found" when I try and click the button in my form to create a folder. I've made sure the path actually does exist, and have tried and failed with multiple other directions for the folder to go to (such as \Documents\ and so forth).
Any help with how to create the folder would be greatly appreciated.
First, "\Test" must exist. Then this will work:
Path = Environ("UserProfile") & "\Documents\Test\" & Me!TimeDateTeam.Value
If Dir(Path, vbDirectory) = "" Then
MkDir Path
End If
I wanted to copy a local file to sharepoint library using VBA by clicking an image. Right now seems like I'm unable to check for Folder & Files on SharePoint.
As every time I ran the code(by clicking an image in excel), it returns unable to find the file in SharePoint. And stops at returning the MsgBox Sorry there's no such Folder......
I tried mapping drive, it works perfectly fine, but not an options because end-user need to map the drive by themselves.
So now I'm looking to connecting to SharePoint using the link.
If I copy the SharePointLink to IE & Chrome using \, it works fine. But if I uses /, IE is unable to find the link.
UPDATE
If I uses \ after few tries, IE, will open up the file path in NetWork. Chrome will show the file path on chrome page. Why is this happening?????
The authentication is using windows authentication, so not an issue.
This is my code
Sub imgClicked()
Dim SharePointLib As String
Dim MyPath As String
Dim folderPath As String
Dim objNet As Object
Dim FSO As Object
Dim copyPath As String
Dim copyFilePath As String
folderPath = Application.ThisWorkbook.path
MyPath = Application.ThisWorkbook.FullName
SharePointLib = "//company.com/sites/MS/10%20Mg%20Review/"
' create new folder to store the file
copyPath = folderPath + "\copyPath\"
If Not FolderExists(copyPath) Then
FolderCreate (copyPath)
ElseIf Not FolderExists(SharePointLib) Then
MsgBox "Sorry there's no such folder. Folder Path: " & vbNewLine & vbNewLine & SharePointLib & ""
Exit Sub
End If
fileName = "hello.xlsm"
'Copy current excel file and save at the new folder created
ThisWorkbook.SaveCopyAs copyPath & fileName
MsgBox "Save Copy As: " + copyPath & filseName & vbNewLine & vbNewLine & "The file will be uploaded to this address: " + SharePointLib & fileName
' Check whether the file exist in the directory
' If exist error message
' else copy the file from copyPath then paste at the SharePoint directory
If Not Dir(SharePointLib & fileName, vbDirectory) = nbNullString Then
MsgBox "Sorry file already exist!"
Else
Call FileCopy(copyPath & fileName, SharePointLib & fileName)
MsgBox "File has being successfuly created in SharePoint!"
End If
Set FSO = CreateObject("scripting.filesystemobject")
If Right(copyPath, 1) = "\" Then
copyPath = Left(copyPath, Len(copyPath) - 1)
End If
If FSO.FolderExists(copyPath) = False Then
MsgBox copyPath & " doesn't exist"
Exit Sub
End If
FSO.DeleteFolder copyPath
MsgBox "Folder has being deleted successfully!"
End Sub
Function for checking if folder exists
Function FolderExists(ByVal path As String) As Boolean
FolderExists = False
Dim FSO As New FileSystemObject
If FSO.FolderExists(path) Then FolderExists = True
End Function
Function for creating Folder
Function FolderCreate(ByVal path As String) As Boolean
FolderCreate = True
Dim FSO As New FileSystemObject
try:
If FSO.FolderExists(path) Then
Exit Function
Else
On Error GoTo catch
FSO.CreateFolder path
Debug.Print "FolderCreate: " & vbTab & path
Exit Function
End If
catch:
MsgBox "A folder could not be created for the following path: " & path & ". Check the path name and try again."
FolderCreate = False
Exit Function
End Function
Any help and suggestions are appreciated. Let me know if more info is needed. Thanks in advance.
Ensure the WebClient service is running. You can start the WebClient service through code, or you could set the startup type to automatic.
With the WebClient service running, your folder/file tests will work as expected.
Edit: Additionally, if you map the sharepoint url to a drive letter, Windows will start the WebClient service.
Sub mapPath(str_drive as string, str_path as string)
If Not Len(str_drive) = 1 Then Exit Sub
Dim wso As Object
Set wso = CreateObject("WScript.Network")
wso.MapNetworkDrive str_drive & ":", str_path, False
End Sub
I am trying to automate unzipping a zip file and extracting the files to a new folder location. I have scoured a bunch of sources and found code that will unzip the folder but it won't actually remove the files inside and put them in the new location, it just copies the zip folder and pastes it to the new location with the password removed. I want it to extract the files inside, and place them in the new folder. Thanks in advance for any help. Here is my code:
Sub Unzip1()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Dim strDate As String
Dim sPathTo7ZipExe As String
Dim sZipPassword As String
sPathTo7ZipExe = "C:\Riley\7Zip\7za.exe" ' <-- change this to where you installed the 7zip command line program
sZipPassword = "password" ' <-- change this to your zip password
Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:=False)
If Fname = False Then
'Do nothing
Else
'Root folder for the new folder.
'You can also use DefPath = "C:\Users\Ron\test\"
'DefPath = Application.DefaultFilePath
DefPath = "C:\Riley\Visual Basic\" ' <-- make sure your path here ends in a \. you were missing that before
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
'Create the folder name
strDate = Format(Now, " dd-mm-yy h-mm-ss")
FileNameFolder = DefPath & "MyUnzipFolder " & strDate & "\"
'Make the normal folder in DefPath
MkDir FileNameFolder
Shell sPathTo7ZipExe & " x -y -p" & sZipPassword & " -o""" & _
FileNameFolder & """ """ & Fname, vbHide
MsgBox "You find the files here: " & FileNameFolder
'On Error Resume Next
'Set FSO = CreateObject("scripting.filesystemobject")
'FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
End Sub
I have an Excel-Macro in VBA in which I want to copy the file from where the macro is executed into another location.
I tried it like this
Call FileCopy(currentDir & "\" & Filename, _
otherDir & "\" & Filename)
But I get an Access restricted Exception, although I have full access to all of the directories involved. Is it because I'm trying to "copy myself"? Is this possible? If not, could I build a workaround?
Try using
ThisWorkbook.SaveCopyAs otherDir & "Test1"
or
ThisWorkbook.SaveAs otherDir & "Test2"
ThisWorkbook refers to the workbook which contains the macro you are running...
Update : This should work for you to create a folder...
Make sure you add "Microsoft Scripting Runtime" under Tools -> references.
Dim fso As FileSystemObject
Set fso = New FileSystemObject
fso.CreateFolder ("C:\test\test2")
ThisWorkbook.SaveCopyAs "c:\test\test2\ttt.xlsm"
Using FileCopy didnt work for me either but using CopyFile from FileSystemObject seems to work.
First you will need to add a Reference (Menu: Tools->References) to the Microsoft Scripting Runtime and then use the FileSystemObject
Dim fso As FileSystemObject
Set fso = New FileSystemObject
fso.CopyFile currentDir & "\" & Filename, otherDir & "\" & Filename, True
''the last parameter decides weather or not you want to overwrite existing files
Set fso = Nothing
Alternative: Save the document at the new destination and then save it back.
ThisWorkbook.SaveAs otherDir & "\" & Filename
ThisWorkbook.SaveAs currentDir & "\" & Filename