I have VBScript that is taking output from a Word file and generating a text file with that output. The current code shown below assumes that I want to create the file in my desktop.
The issue that I am having is that I plan to use wine on Linux to execute my VBScript. Is there anyway that i can modify this code to specify the Linux path to output this file?
fileName = "\out.txt"
strPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & fileName
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile As Object
Set oFile = fso.CreateTextFile(strPath)
Related
I'm trying to convert a little over 200 .txt files into .xlsx files. This is the code I'm using:
Dim wb As Excel.Workbook
Dim FSO As New FileSystemObject
Dim obj_folder As Object
Dim file As Object
Dim path As String
Dim destination As String
Dim file_name As String
path = "C:\Users\ABCD\Desktop\Attributes Files\"
destination = "C:\Users\ABCD\Desktop\Attributes xlx\"
Set FSO = CreateObject("Scripting.filesystemobject")
Set obj_folder = FSO.GetFolder(path)
For Each file In obj_folder.Files
file_name = Left(file.Name, (InStrRev(file.Name, ".", -1, vbTextCompare) - 1))
Call Workbooks.OpenText(Filename:=file, DataType:=xlDelimited, Tab:=True)
Set wb = ActiveWorkbook
wb.SaveAs Filename:=destination & file_name & ".xlsx"
wb.Close savechanges:=False
Next file
When the code is finished running and I go to open the .xlsx workbook, I receive an error that states Excel cannot open the file because the file format or file extension is not valid. Verify that the file has not been corrupted and that the file extension matches the format of the file.
I'm not sure what to do here as I know this works when I manually change one .txt file workbook to a .xlsx file type. I even recorded the macro and it more or less matches up with my code that I have here. (on one attempt I even copied down the recorded macro exactly and it still wouldn't let me open the .xlsx file after it finished.) Any help would be appreciated.
You never cite what file format you save in. You want to use xlOpenXMLWorkbook = 51
It looks like you pass the object file to the Filename paramter of open. I would use file.Name just like you do when you are building the output name.
Using a With block will gracefully handle the workbook object for you.
FSO.GetBaseName will remove the extension of the filename for you.
Dim FSO As New FileSystemObject
Set FSO = CreateObject("Scripting.filesystemobject")
Dim path As String
path = "C:\Users\ABCD\Desktop\Attributes Files\"
Dim destination As String
destination = "C:\Users\ABCD\Desktop\Attributes xlx\"
Dim file As Object
For Each file In FSO.GetFolder(path).Files
Dim file_name As String
file_name = FSO.GetBaseName(file.Name)
With Workbooks.OpenText(Filename:=file.Name, DataType:=xlDelimited, Tab:=True)
.SaveAs Filename:=destination & file_name & ".xlsx", FileFormat:=51
.Close savechanges:=False
End With
Next file
I have a little problem with my code in VBA, How can I exclude the other extension file like .txt, .csv, .xlsx, and .xlsm so I can select only in my For Each Loop is the .PDF extension only.
I've already searched about this issue and already tried, But the solution is not applicable in my code.
This is my code:
Option Explicit
Sub GetPDFFile()
Dim mainWs As Worksheet
Dim pdfPath As Variant, excelPath As Variant
Dim fileSystemObject As New fileSystemObject
Dim getFolderPath As Folder
Dim getFile As file
Dim wb As Workbook
Set mainWs = ThisWorkbook.Sheets("Main")
pdfPath = mainWs.Range("C7").Value
excelPath = mainWs.Range("C8").Value
'Set all variable to null
Call SetNothing
If pdfPath = "" Then
Call MsgActionInvalid("Please input PDF File Folder.")
ElseIf excelPath = "" Then
Call MsgActionInvalid("Please input Output Folder Location.")
Else
Set getFolderPath = fileSystemObject.getFolder(pdfPath)
Set wa = CreateObject("word.application")
If cntFiles <> 0 Then
For Each getFile In getFolderPath.Files
`Other code............
Next
End Sub
I'm getting all the files inside the folder that I've selected. So inside the For Each Loop I'm getting a debug message because the file is not .PDF.
Any ideas about this guys?
Thanks in advance.
Use the Type property of the File object like getFile.Type to find out its type. And use a If statement to run your Other code............ only on the desired type of files.
Alternatively use UCase(getFile) Like "*.PDF" to make sure that it is not case sensitive. Otherwise you only trigger .PDF but not .Pdf or .pdf or .pDf or whatever.
Which is the same as UCase(Right$(getFile, 4)) = ".PDF"
You should be using Right to check the file extension. Something like:
For Each getFile In getFolderPath.Files
If Right(getFile, 4) = ".pdf" Then
' have found a PDF extension............
End If
Next
Regards,
I am trying to write some macros in both Excel and Outlook that in the end will automatically unzip and open a CSV, process the data, and sends it where it needs to go when a new email arrives in a specific folder. I have everything worked out on the Excel side but I am having difficulties with Outlook. The below code unzips the file. How would i go about opening the unzipped file and triggering an Excel macro (which is always open in another workbook)?
Another issue I am running into: this code only seems to work when i actually open the target email in it's own window.
Public Sub OpenZippedSheet()
Dim objMail As Outlook.MailItem
Dim objAttachments As Outlook.Attachments
Dim objAttachment As Outlook.Attachment
Dim objShell As Object
Dim objFileSystem As Object
Dim strTempFolder As String
Dim strFilePath As String
Dim strFileName As String
Set objMail = Outlook.Application.ActiveInspector.CurrentItem
Set objAttachments = objMail.Attachments
'Save & Unzip the zip file in local drive
Set objShell = CreateObject("Shell.Application")
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
strTempFolder = objFileSystem.GetSpecialFolder(2).Path & "\Temp" & Format(Now, "yyyy-mm-dd-hh-mm-ss")
MkDir (strTempFolder)
For Each objAttachment In objAttachments
If Right(objAttachment.FileName, 3) = "zip" Then
strFilePath = strTempFolder & "\" & objAttachment.FileName
objAttachment.SaveAsFile (strFilePath)
objShell.NameSpace((strTempFolder)).CopyHere objShell.NameSpace((strFilePath)).Items
End If
Next
End Sub
I'm assuming I would do some sort of object.open but I don't know what the syntax would be to get it to actually open in Excel. And then is there a way to trigger an Excel macro from Outlook?
Thanks so much in advance!
this code only seems to work when i actually open the target email in it's own window.
That is because you rely on the ActiveInspector window. If you want to handle items selected in the Explorer windows you need to check the Selection object (see the corresponding property).
To open an Excel file you can:
Use the Shell.ShellExecute method. This method is equivalent to launching one of the commands associated with a file's shortcut menu. Each command is represented by a verb string. The set of supported verbs varies from file to file. The most commonly supported verb is "open", which is also usually the default verb. Other verbs might be supported by only certain types of files.
Automate Excel from your VBA macro to do the required actions. See How to automate Microsoft Excel from Visual Basic for more information.
To run your VBA macro code from other applications you can use the Application.Run method. Read more about that in the How do I use Application.Run in Excel article.
Application.Run "'" & TestWkbk.Name & "'!MacroNameHere", "parm1", "parm2"
Something like this (untested so may need some fixes):
'Note - any paths passed to objShell should be
' passed as *Variants*, not Strings
Dim oXL As Object, wbCSV As Object, fileNameInZip As Variant
Set objShell = CreateObject("Shell.Application")
For Each objAttachment In objAttachments
If Right(objAttachment.Filename, 3) = "zip" Then
strFilePath = strTempFolder & "\" & objAttachment.Filename
objAttachment.SaveAsFile strFilePath
Set oNS = oApp.Namespace(strFilePath)
For Each fileNameInZip In oNS.items 'loop over the files in the zip
Debug.Print fileNameInZip
If LCase(fileNameInZip) Like "*.csv" Then 'csv file?
'extract the file
objShell.Namespace(strTempFolder).copyhere oNS.items.Item(CStr(fileNameInZip))
If oXL Is Nothing Then Set oXL = GetObject(, "Excel.Application") 'assumes excel is running
Set wbCSV = oXL.Workbooks.Open(strTempFolder & "\" & fileNameInZip)
oXL.Run "'YourMacroFile.xlsm'!YourMacroName" 'run the macro
'clean up stuff...
End If 'is a csv file
Next 'file in zip
End If 'attachment is a zip file
Next 'attachment
I have some excel files in a share point folder. I would need the content from all the files to be collated to one single sheet using VBA.
I get the path as below and try to connect to the path where the files are available.The below code is not able to connect or read the file from the path.
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As File
strspURL = ThisWorkbook.Worksheets("Main").Cells(6, 7).Value
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strspURL)
I'm using Microsoft Scripting Runtime (FSO) to parse folders and produce a list of all of its contents, the folders are on a network and resultant paths end up longer than 260. The minimum code I have is as below:-
Private Sub ProcessFolder(ByVal StrFolder As String)
Dim Fl As File
Dim Fldr As Folder
Dim RootFldr As Folder
Set RootFldr = FS.GetFolder(StrFolder)
For Each Fl In RootFldr.Files
Debug.Print Fl.Path
Next
For Each Fldr In RootFldr.SubFolders
DoEvents
ProcessFolder Fldr.Path
Next
Set RootFldr = nothing
End sub
At a certain level StrFolder length became 259, the Set RootFldr ... folder line worked but For Each Fl In RootFldr.Files gave the error of 76: Path not found, presumably because the content causes the path to breach the 260 limit.
There were files in the folder when looking in Windows Explorer. I am using Excel as the host for this code as I'm outputting the result to workbooks.
Just to be super clear on my question and its background, I need to use FSO (happy to be shown alternatives if they exist) to access files deeper than 260 characters deep in their network path. I need it as FSO as the tool I have is taking the folder paths and the file paths, name, size created, and modified.
The technique to convert MAXFILE encumbered DOS path names to native OS path names is well established and documented. Summarizing:
Prefix a path that uses a drive letter with \\?\, like \\?\C:\foo\bar\baz.txt
Prefix a path that uses a file share with '\\?\UNC\, like \\?\UNC\server\share\baz.txt.
Works well with FileSystemObject too, at least when I tested your code on Windows 10. That might not necessarily be the case in older Windows versions or with the network redirector on your server. Tested by using the FAR file manager to create subdirectories with long names and verified with:
Dim path = "\\?\C:\temp\LongNameTest"
ProcessFolder path
Produced:
\\?\c:\temp\LongNameTest\VeryLongFolderName0123456789012345678901234567890123456789012345678901234567890123456789\VeryLongFolderName0123456789012345678901234567890123456789012345678901234567890123456789\VeryLongFolderName0123456789012345678901234567890123456789012345678901234567890123456789\VeryLongFolderName0123456789012345678901234567890123456789012345678901234567890123456789\VeryLongFolderName0123456789012345678901234567890123456789012345678901234567890123456789\Chrysanthemum.jpg
Which is 488 characters long. Things to keep in mind:
Native path names must be full paths, they cannot be relative paths. In other words, they must always start with a drive letter or share name and start from the root of the drive/share.
You get the native path name back, don't forget to strip the prefix off again if you display it.
Not tested but should fail, there is still a limitation on the the length of the filename itself (without the directory names), can't be longer than 259 chars. Shouldn't be a problem at all since the user can't create them either.
This took a little creative coding but the use of ShortPath was the answer.
This tool was to create a list of every folder and file in a root folder, the files also showing their size, and created/modified dates. The issue was when the resultant path of a file or folder was over 260, then the error Error 76: Path Not Found was thrown and the code would not capture the content of that area.
Using Microsoft Scripting Runtime (FSO) ShortPath would get around this issue but the path went from human readable to coded:-
Full path
\\ServerName00000\Root_Root_contentmanagement\DPT\STANDARDS_GUIDELINES\VENDOR_CERTIFICATION_FILES\PDFX_CERTIFICATION_ALL\2006_2007\DPT\CompantName0\Approved\Quark\India under Colonial Rule_structure sample\058231738X\Douglas M. Peers_01_058231738X\SUPPORT\ADDITIONAL INFORMATION\IUC-XTG & XML file
Short Path
\\lo3uppesaapp001\pesa_cmcoe_contentmanagement\CTS\S4SJ05~5\V275SE~8\PDM5D9~G\2N52EQ~5\HPE\GS9C6L~U\Approved\Quark\IQPSJ5~F\0CWHH1~G\DOFNHA~8\SUPPORT\A6NO7S~K\IUC-XTG & XML file
(Note I've altered the full path to protect IP and company info but the size is the same)
You can see while I could pass short path to someone and they could put it into Windows Explorer to get there, they would know know where it went by simply looking, to get around this a used a global variable that kept the folder path as a full string and followed what the short path was doing. this string is then what I output to the user. The below code is cut down but shows how I achieved it.
The short answer is ShortPath in FSO will get past the issue but the path will not be pretty.
Dim FS As New FileSystemObject
Dim LngRow As Long
Dim StrFolderPath As String
Dim WkBk As Excel.Workbook
Dim WkSht As Excel.Worksheet
Public Sub Run_Master()
Set WkBk = Application.Workbooks.Add
WkBk.SaveAs ThisWorkbook.Path & "\Data.xlsx"
Set WkSht = WkBk.Worksheets(1)
WkSht.Range("A1") = "Path"
WkSht.Range("B1") = "File Name"
WkSht.Range("C1") = "Size (KB)"
WkSht.Range("D1") = "Created"
WkSht.Range("E1") = "Modified"
LngRow = 2
Run "\\ServerName00000\AREA_DEPT0_TASK000"
Set WkSht = Nothing
WkBk.Close 1
Set WkBk = Nothing
MsgBox "Done!"
End Sub
Private Sub Run(ByVal StrVolumeToCheck As String)
Dim Fldr As Folder
Dim Fldr2 As Folder
Set Fldr = FS.GetFolder(StrVolumeToCheck)
'This is the variable that follows the full path name
StrFolderPath = Fldr.Path
WkSht.Range("A" & LngRow) = StrFolderPath
LngRow = LngRow +1
For Each Fldr2 In Fldr.SubFolders
If (Left(Fldr2.Name, 1) <> ".") And (UCase(Trim(Fldr2.Name)) <> "LOST+FOUND") Then
ProcessFolder Fldr2.Path
End If
Next
Set Fldr = Nothing
End Sub
Private Sub ProcessFolder(ByVal StrFolder As String)
'This is the one that will will be called recursively to list all files and folders
Dim Fls As Files
Dim Fl As File
Dim Fldrs As Folders
Dim Fldr As Folder
Dim RootFldr As Folder
Set RootFldr = FS.GetFolder(StrFolder)
If (RootFldr.Name <> "lost+found") And (Left(RootFldr.Name, 1) <> ".") Then
'Add to my full folder path
StrFolderPath = StrFolderPath & "\" & RootFldr.Name
WkSht.Range("A" & LngRow) = StrFolderPath
WkSht.Range("D1") = RootFldr.DateCreated
WkSht.Range("E1") = RootFldr.DateLastModified
Lngrow = LngRow + 1
'This uses the short path to get the files in FSO
Set Fls = FS.GetFolder(RootFldr.ShortPath).Files
For Each Fl In Fls
'This output our string variable of the path (i.e. not the short path)
WkSht.Range("A" & LngRow) = StrFolderPath
WkSht.Range("B" & LngRow) = Fl.Name
WkSht.Range("C" & LngRow) = Fl.Size /1024 '(bytes to kilobytes)
WkSht.Range("D" & LngRow) = Fl.DateCreated
WkSht.Range("E" & LngRow) = Fl.DateLastModified
LngRow = LngRow + 1
Next
Set Fls = Nothing
'This uses the short path to get the sub-folders in FSO
Set Fldrs = FS.GetFolder(RootFldr.ShortPath).SubFolders
For Each Fldr In Fldrs
'Recurse this Proc
ProcessFolder Fldr.Path
DoEvents
Next
Set Fldrs = Nothing
'Now we have processed this folder, trim the folder name off of the string
StrFolderPath = Left(StrFolderPath, Len(StrFolderPath) - Len(RootFldr.Name)+1)
End If
Set RootFldr = Nothing
End Sub
As mentioned this is a cut version of the code that is working for me to exemplify the the method used to get past this limit. Actually seems quite rudimentary once I'd done it.
I got around this once using the subst command of the command shell. It allows you to assign a drive letter to a local path (kind of like a network share).