I want to open the folder before the current Directory each time. I tried "..\" but it didn't work, can you help me with that N
ThecurrentDirectory= fso.GetParentFolderName(objFile)
Set myWorkBook = myxlApplication.Workbooks.Open( ThecurrentDirectory & "\..\CLIENTS.xlsx" )
If objFile is a file object then you can chain it's ParentFolder property together multiple times to get the disred result:
Dim fso, f
Set fso = WScript.CreateObject("Scripting.Filesystemobject")
Set objFile = fso.GetFile("C:\Users\best buy\Downloads\stackoverfow\test.xlsm")
Output:
objFile.ParentFolder.ParentFolder = C:\Users\best buy\Downloads
Just pack the ThecurrentDirectory in another fso.GetParentFolderName.
ThecurrentDirectory= fso.GetParentFolderName(objFile)
Set myWorkBook = myxlApplication.Workbooks.Open( fso.GetParentFolderName(ThecurrentDirectory) & "\CLIENTS.xlsx" )
Related
Is there a method in VBA to achieve the same effect of right-clicking on a folder in the folder pane and selecting 'Sort Subfolders A to Z'?
As a comparison, the code below from Microsoft.com sorts Items in a folder; however, it does not appear that the .Sort method used in this code is available for the Folders object like it is for the Items object.
Sub SortByDueDate()
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.Folder
Dim myItem As Outlook.TaskItem
Dim myItems As Outlook.Items
Set myNameSpace = Application.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
myItems.Sort "[DueDate]", False
For Each myItem In myItems
MsgBox myItem.Subject & "-- " & myItem.DueDate
Next myItem
End Sub
Additionally, it does not appear that there are any methods available for moving folders in the tree.
Is more extensive code required to replicate the native 'Sort Subfolders A to Z' action with VBA?
Can this be achieved with PropertyAssessor and, if so, what is the proper syntax for setting the PR_SORT_POSITION property? For example, the code below results in an error, as commented in the code.
Sub Example()
Dim myProp As String
Dim myValue As Variant
Dim oFolder As Folder
Set oFolder = Application.Session.GetDefaultFolder(olFolderInbox)
myProp = "http://schemas.microsoft.com/mapi/proptag/0x30200102"
myValue = "FD7F"
oFolder.PropertyAssessor.SetProperty myProp, myValue 'Run-time error '438': Object doesn't support this property or method
End Sub
The Outlook object model doesn't provide any property or method to sort folders. You may find the NavigationPane object helpful. See Customizing the Navigation Pane for more information.
You can sort the folders in the Outlook UI by explicitly setting the PR_SORT_POSITION property on each subfolder - see Get folder list ordered as displayed
I posted my code here because this was high in Google results and all other threads were closed
https://answers.microsoft.com/en-us/outlook_com/forum/all/sorting-outlook-subfolders-z-a/9aef727c-510c-49e0-869d-4234373b71d7
https://answers.microsoft.com/en-us/outlook_com/forum/all/sort-order-of-subfolders/a3b55181-4f5a-43c1-82b3-94eb68a8407b
I've made custom VBA code to sort subfolders Z-A - it will load the folder order [unfortunately you still need to order it A-Z within outlook] and then reverse it so it is Z-A
I needed to quickly adjust a tonne of folders and couldn't find any code anywhere, so I quickly made the below to help patch the issue.
I didn't have the time to write lots of detail about how it works.
Known issues with the code:
It doesn't always sort the first folder. No idea why.
It doesn't seem to like it when you're looking at the list of subfolders - minimise it then run the code
This code is used to reverse the sorting of subfolders under Inbox, you'll need to adjust as required.
Sub sortZA()
Dim email_name: email_name = "email#emails.com" 'write the name of the mailbox as it appears in outlook
Dim objMainFolder As Outlook.Folder
Dim Folders As Outlook.Folders
Dim Folderx As Outlook.Folder
Dim sort_order, sort_order_b, arr
Set arr = CreateObject("System.Collections.ArrayList")
Set arr_sorted = CreateObject("System.Collections.ArrayList")
dim found_folder: found_folder=0
Set Folders = Application.ActiveExplorer.Session.Folders
For Each Folderx In Folders
If LCase(Folderx.Name) = LCase(email_name) Then
Set objMainFolder = Folderx.Folders("Inbox") 'adjust as required. Add more folders via .folders("name")
found_folder=1
End If
Next
if found_folder =0 then
msgbox "the email folder with the name '" & email_name & "' was not found"
exit sub
end if
Dim reloadFolder As Outlook.Folder
Dim propertyAccessor As Outlook.propertyAccessor
For Each Folderx In objMainFolder.Folders
' if there is an error, then there might not be any order data. Try reordering them manually. Also make sure loading the email as the main profile instead of as an additional mailbox.
'On Error Resume Next
Set propertyAccessor = Folderx.propertyAccessor
sort_order = propertyAccessor.BinaryToString(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x30200102"))
arr.Add Folderx.Name & "##~~##" & sort_order
arr_sorted.Add Folderx.Name & "##~~##" & sort_order
Next
arr.Sort 'keep A-Z (the original list from outlook isn't in A-Z order)
arr_sorted.Sort 'make A-Z
arr_sorted.Reverse 'make Z-A
Dim t, a, b, i, t2, a2, b2
i = 0
For Each arr_folder In arr
t = Split(arr_folder, "##~~##")
a = t(0) 'which folder name?
b = t(1) 'what is the original order? [should already be A-Z]
Set Folders = Application.ActiveExplorer.Session.Folders
For Each Folderx In Folders
'On Error Resume Next
If LCase(Folderx.Name) = LCase(email_name) Then
Set reloadFolder = Folderx.Folders("Inbox").Folders(a)
End If
Next
t2 = Split(arr_sorted(i), "##~~##")
a2 = t2(0) 'which folder name?
b2 = t2(1) 'what is the reversed order?
Set propertyAccessor = reloadFolder.propertyAccessor
propertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x30200102", propertyAccessor.StringToBinary(b2)
i = i + 1
Next
End Sub
Additional Notes: I did try experimenting with applying ordering data manually. I couldn't get it to work properly. All the binary converting code wasn't producing the correct values, and I ended up using HEX(). Here is an example of what I was doing:
Dim custom_order As Long
custom_order = 15
For Each arr_folder In arr
'the array only contains a list of folder names.. we need to load the folder in outlook to process it again. The below line of code loads the main email inbox, then the subfolder from the array [different from the above code]
Set reloadFolder = Application.Session.GetDefaultFolder(olFolderInbox).Folders(arr_folder)
Set propertyAccessor = reloadFolder.propertyAccessor
hexval = Hex(custom_order)
propertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x30200102", propertyAccessor.StringToBinary(hexval)
custom_order = custom_order + 1
Next
End Sub
It seems like I just cant add a copied Part two a productDoc. Its possible to paste it directly into the ProductDocument, but than I cant save it. What I need to do is:
Create ProductDoc
Create a ProductDoc in rootProductDoc
Copy Part from another Doc
Paste Part in ProductDoc from second step
Anyone an idea how to do that?
Im using CATIA V5-6 Release 2016, ServicePack 5 Build Number 26
There just dont seem any functions to select the ProductDoc from step 2.
I figured it out, thanks downvoters.
You cannot add a PartDocument itself to a Product, it needs to be a ProductDocument to which a Part is added (with AddNewComponent("Part","")).
Dim documents1 As Documents
Set documents1 = CATIA.Documents
Dim productDoc As ProductDocument
Set productDoc = documents1.Add("Product")
Dim rootProduct As Product
Set rootProduct = productDoc.Product
Dim childProduct As Product
Set childProduct = rootProduct.Products.AddNewComponent("Product", "")
Dim part1 As Product
Set part1 = childProduct.Products.AddNewComponent("Part", "")
Dim part2 As Product
Set part2 = childProduct.Products.AddNewComponent("Part", "")
MaxVR, thanks for coming back and posting the solution! It was really helpful for the product symmetry macro I'm working on. There's another way to insert parts into a CATProduct if the parts already exist.
'These three lines are variants
'products_variant_file_open represents the product that we want our part to be added to
'variant_array_file_open is where we store our file path
Dim products_variant_file_open
Set products_variant_file_open = current_rh_product.Products
Dim variant_array_file_open(0)
variant_array_file_open(0) = root_file_location & "\" & current_product.PartNumber & "_RH.CATPart"
'Below is the command that inserts the CATPart. The left thing to specify is the array that holds
'the file name and the right thing is the type of file to add
Here's some sample code that shows how I got my file path to insert parts from
'prod_doc.Path gets path of the product document and the stuff to the right becomes the folder name
root_file_location = prod_doc.Path & "\" & name_prod.Name & "_RH_Parts"
Dim fso As FileSystemObject
Set fso = New FileSystemObject
'Creates a folder in specified path with the specified name
fso.CreateFolder (root_file_location)
Then I used a function to loop through the folder and search for specific names
Function rh_folder_lookup(rh_part_file_name As String,
root_file_location_func As String)
'Default rh folder lookup to be false when it's false we can't find a matching file in our folder so we make a new rh part
rh_folder_lookup = False
'Set the file name to all the files in our folder
Dim fileName As Variant
fileName = Dir(root_file_location_func & "\") 'The slash at the ends makes the directory all the files in the folder instead of just that folder
'Loop through all files in a folder
While fileName <> ""
If fileName = rh_part_file_name & ".CATPart" Or fileName = rh_part_file_name Then
'MsgBox fileName & "!!!"
rh_folder_lookup = True
Exit Function
End If
fileName = Dir 'Set the fileName to the next file
Wend 'Wend means end when the condition is true
End Function
I have created a VBA subroutine to list any and all sub-folders that have "NNN" text in the name in a list-box on a userform - I have loads of sub-folders and finding the right one is therefore time consuming. This routine works perfectly.
However, what I now want to do is to double-click on a list-box item and it "selects" the folder in the folder hierarchy to save me the time to locate it manually (it could be several levels down).
I have a snippet that does this:
Public Sub GetItemsFolderPath()
Dim obj As Object
Dim F As Outlook.MAPIFolder
Dim Msg$
Set obj = Application.ActiveWindow
If TypeOf obj Is Outlook.Inspector Then
Set obj = obj.CurrentItem
Else
Set obj = obj.Selection(1)
End If
Set F = obj.Parent
Msg = "The path is: " & F.FolderPath & vbCrLf
Msg = Msg & "Switch to the folder?"
If MsgBox(Msg, vbYesNo) = vbYes Then
Set Application.ActiveExplorer.CurrentFolder = F
End If
End Sub
However, if I try and replace "F" with a folder path which is just a string, it fails.
So my question is, how can I select the folder using just a string for the folder path like "paul#anymail.com\Inbox\03_Group Finance\00_Organization Chart"
Thanks
I tried this little simple thing to return a folder from a path:
Function FolderFromPath(FolderPath As String) As Folder
Dim F As Folder
Dim arrFolders() As String
Dim i As Integer
Set myNamespace = Application.GetNamespace("MAPI")
Set F = myNamespace.GetDefaultFolder(olFolderInbox)
arrFolders = Split(FolderPath, "\")
For i = 4 To UBound(arrFolders)
Set F = F.Folders(arrFolders(i))
Next
Set FolderFromPath = F
End Function
It starts from your inbox (which perhaps isn't what you need), and then splits the path and goes into each folder in the path.
Update after comment
I forgot to show how to use it. You can do it like this:
Path = "\\first.last#company.com\Inbox\Folder1\Folder2"
Set Application.ActiveExplorer.CurrentFolder = FolderFromPath(Path)
The method described by Sam will do what you want. There is a small problem with the code. The index starts to far along the path. 4 should be 2 if the initial reference is to the Inbox.
Function FolderFromPath(FolderPath As String) As Folder
Dim F As Folder
Dim arrFolders() As String
Dim i As Long
arrFolders = Split(FolderPath, "\")
' Initial reference is to the mailbox - array element 0
Set F = Session.Folders(arrFolders(0))
' The next folder is array element 1
For i = LBound(arrFolders) + 1 To UBound(arrFolders)
Set F = F.Folders(arrFolders(i))
Next
Set FolderFromPath = F
End Function
Public Sub GetItemsFolderPath_Test()
Dim FPath As String
FPath = "paul#anymail.com\Inbox\03_Group Finance\00_Organization Chart"
Set ActiveExplorer.CurrentFolder = FolderFromPath(FPath)
End Sub
as a beginner , i have been with this problem 2 days and i am desperate for your help .
My text file is :
C:\Sourcefile\imported
C:\Destination\not imported
C:\Testexcel\test.xlxs
and i need to read the text and use these path in vba .
The object of the vba code is to create a new folder if it not existe in the destination .
FSO = CreateObject("Scripting.FileSystemObject")
set oSourceFolder=FSO.getfolder(Line1,Readline) 'if i replace line with the path it will work
set oSourceFolder=FSO.getfolder(Line2,Readline)
set oSourceFolder=FSO.getfolder(Line3,Readline)
if dir("C:\Destination\not imported",16)="" Then Mkdir (":\Destination\not imported")
Here , i want to replace the path with the line but it is not working .
Can you help me please ?
you must
add Set keyword at the beginning of
FSO = CreateObject("Scripting.FileSystemObject")
use ReadLine method of TextStream object to retrieve every single line of the text file into a string object
parse that string returned for possible files specification and get only their its path part
use FolderExists method of FileSystemObject object to check for existing folders
and finally get (if existent) that folder or create (if non existent) it via GetFolder or CreateFolder methods of FileSystemObject object
much like follows:
Option Explicit
Sub main()
Dim FSO As FileSystemObject
Dim foldersListFile As TextStream
Dim folderName As String
Dim oSourceFolder As Folder
Set FSO = CreateObject("Scripting.FileSystemObject")
Set foldersListFile = FSO.OpenTextFile("C:\myPath\folders.txt", ForReading, TristateFalse)
Do While Not foldersListFile.AtEndOfStream
folderName = GetFolderStringOnly(foldersListFile.ReadLine)
If FSO.FolderExists(folderName) Then
Set oSourceFolder = FSO.GetFolder(folderName)
Else
Set oSourceFolder = FSO.CreateFolder(folderName)
End If
Loop
foldersListFile.Close
End Sub
Function GetFolderStringOnly(textLine As String) As String
Dim iDot As Long, iSlash As Long
iDot = InStrRev(textLine, ".")
If iDot > 0 Then
iSlash = InStrRev(Left(textLine, iDot), "\")
textLine = Left(textLine, iSlash - 1)
End If
GetFolderStringOnly = textLine
End Function
I am working on a project in VBA where I'm searching a directory for files of a certain date that also meet other criteria, and all of that is working fine. What I am stuck on, which should be a trivial issue, is that when I try to use FileCopy to copy the file to another folder, I keep getting a path/file access error. This confuses me because I am pulling the path directly from the FileItem I'm using to search for the criteria, I'm the person who created both the source and destination folders, and put the files in the source folder. Any thoughts?
Sub ListFilesInFolder()
Dim counter As Integer
Dim theString1 As String, theString2 As String
theString1 = "ISA*00*"
theString2 = "ISA|00|"
Dim line As String, fileName As String
Dim datestring As String
'datestring = Format(FileItem.DateLastModified, "mm/dd/yyyy")
Dim today As String
today = Format(DateAdd("d", -2, Date), "mm/dd/yyyy")
Dim destinationFolder As String
destinationFolder = "C:\Users\kragan\Desktop\test\folder2"
Dim file As TextStream
Dim FSO As Scripting.FileSystemObject
Set FSO = New Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Set SourceFolder = FSO.GetFolder("C:\Users\kragan\Desktop\test\folder1")
Dim FileItem As Scripting.file
For Each FileItem In SourceFolder.Files
datestring = "10/18/2015"
If (datestring = today) Then
Do While (SourceFolder <> "")
Set file = FSO.OpenTextFile(FileItem)
counter = 0
Do While Not file.AtEndOfLine And counter < 1
line = file.ReadLine
If InStr(1, line, theString1, vbTextCompare) > 0 Or InStr(1, line, theString2, vbTextCompare) > 0 Then
fileName = "C:\Users\kragan\Desktop\test\folder1\" + FSO.GetBaseName(FileItem) + ".AETCLS"
'The line where I get the error:
FileCopy fileName, destinationFolder
file.Close
counter = counter + 1
Exit Do
End If
Loop
Loop
End If
Next FileItem
MsgBox ("done")
End Sub
You need to specify destination folder + destination file name (and not only destination folder).
So this will work:
FileCopy fileName, destinationFolder & "\" & FSO.GetBaseName(FileItem) & ".AETCLS"
You were probably assuming this will work like a file manager application, where giving destination folder is enough... :) But when programming, you need to specify destination path exactly as it is, i.e. including the file name.
One of my friends was getting similar error on creating directory newdir1\newdir2\newdir3. It was not working despite his best effort. But the solution was to create newdir1, then it became possible to specify newdir1\newdir2, then finally newdir1\newdir2\newdir3. Programming file operations does not do the job often seen in file managers, but everything must be specified in detail and performed in elementary steps.
Thanks for your help. What I discovered is that you have to have the full destination path, including the file name, even though it isn't changing. Solved!