I need to create vbscript which will create new folder 'test' and subfolder 'Output'.There is already a folder structure C:\Documents and Settings\All Users\Application Data\Fmwire,I need to create test\Output under those structure
I have created vbscript like this but i am getting error like this
Error: Path not found
Code: 800A004C
Source: Microsoft VBScript runtime error
Const OSCPATH = "\Fmwire\test\Output"
Const ALL_USERS_APPLICATION_DATA = &H23&
Dim fso ' File System Object
Dim objApplication ' Application object
Dim objFolder ' Folder object
Dim objFolderItem ' FolderItem object
Dim fname ' Path to Settings folder
Set objApplication = CreateObject("Shell.Application")
Set objFolder = objApplication.Namespace(ALL_USERS_APPLICATION_DATA)
Set objFolderItem = objFolder.Self
fname = objFolderItem.Path & OSCPATH
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(fname) Then
Set objFolder = fso.GetFolder(fname)
Else
Set objFolder = fso.CreateFolder(fname)
If Err Then
Err.Clear
strErr = SPOFOLDERFAIL
rCode = 4
End If
End If
What changes i have to do for correcting this
Const OSCPATH = "\Fmwire\test\Output"
Const ALL_USERS_APPLICATION_DATA = &H23&
Set objApplication = CreateObject("Shell.Application")
Set objFolder = objApplication.Namespace(ALL_USERS_APPLICATION_DATA)
Set objFolderItem = objFolder.Self
fname = objFolderItem.Path
Set fso = CreateObject("Scripting.FileSystemObject")
folders = Split(OSCPATH, "\")
For i = 0 To UBound(folders)
fname = fso.BuildPath(fname, folders(i))
If fso.FolderExists(fname) Then
Set objFolder = fso.GetFolder(fname)
Else
Set objFolder = fso.CreateFolder(fname)
If Err Then
Err.Clear
strErr = SPOFOLDERFAIL
rCode = 4
End If
End If
Next
Related
'I have 2 scripts but could not combine them
'create multiple folders script:
Dim objFSO, objFolder, strDirectory, i
strDirectory = "C:\Users\test\Desktop\"
Set objFSO = CreateObject("Scripting.FileSystemObject")
i = 1 ''
While i < 150
Set objFolder = objFSO.CreateFolder(strDirectory & i)
i = i+1
''WScript.Quit ''
Wend
'desktop path script
set WshShell = WScript.CreateObject("WScript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")
wscript.echo(strDesktop)
I want the code to automatically find the desktop path and then create the folders, some one help me please ?
To get the desktop folder path string and create a sub directory you can do this:
Set objShell = Wscript.CreateObject("Wscript.Shell")
strPath = objShell.SpecialFolders("Desktop")
Dim objFso
Set objFso = WScript.CreateObject("Scripting.FileSystemObject")
If Not objFso.FolderExists(strPath + "\NewFolder") Then
objFso.CreateFolder strPath + "\NewFolder"
I'm trying to create a VBS script that will grab all the fonts from the server font location so that the domain user will have the ability to use them. When I run this script I get a line 15 char 1 error: 800A400C.
Not sure what is wrong with it or if this script will do the job I'm wanting it to do.
'On Error Resume Next
'Option Explicit
Dim objShell, objFSO, wshShell
Dim strFontSourcePath, objFolder, objFont, objNameSpace, objFile, strFontsSytem
Set objShell = CreateObject("Shell.Application")
Set wshShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FilesyStemObject")
strFontSourcePath = "\\server\Fonts\"
strFontsSytem = WSHShell.SpecialFolders("Fonts") & "\"
Set objNameSpace = objShell.Namespace(strFontSourcePath)
Set objFolder = objFSO.GetFolder(strFontSourcePath)
For Each objFile In objFolder.Files
If LCase(Right(objFile, 4)) = ".ttf" Or LCase(Right(objFile, 4)) = ".otf" Then
Set objFont = objNameSpace.ParseName(objFile.Name)
If objFSO.FileExists(strFontsSytem & objFile.Name) = False Then
objFont.InvokeVerb("Install")
Set objFont = Nothing
End If
End If
Next
Set objShell = Nothing
Set wshShell = Nothing
Set objFSO = Nothing
Set objNameSpace = Nothing
Set objFolder = Nothing
WScript.Quit
Error code 800A004C means Path not found. Please check the existance of the strFontSourcePath and like Ansgar says also check if the user running this code has access to this share.
Anyway, Here's my code to copy and install fonts from a server share if that is any help
Call AddFonts("\\server\Fonts\")
WScript.Quit
Private Sub AddFonts(strFromPath)
' install fonts from a server location if not already present
Dim appShell, objShell, objFSO, colFiles, objFile, objFolder
Dim strToPath, flags, strFile, strExt
'SpecialFolder. See: https://technet.microsoft.com/en-us/library/ee176604.aspx
Const FONTFOLDER = &H14&
'CopyHere switches
Const FOF_MULTIDESTFILES = &H1&
Const FOF_CONFIRMMOUSE = &H2&
Const FOF_SILENT = &H4&
Const FOF_RENAMEONCOLLISION = &H8&
Const FOF_NOCONFIRMATION = &H10&
Const FOF_WANTMAPPINGHANDLE = &H20&
Const FOF_ALLOWUNDO = &H40&
Const FOF_FILESONLY = &H80&
Const FOF_SIMPLEPROGRESS = &H100&
Const FOF_NOCONFIRMMKDIR = &H200&
Const FOF_NOERRORUI = &H400&
Const FOF_NOCOPYSECURITYATTRIBS = &H800&
Const FOF_NORECURSION = &H1000&
Const FOF_NO_CONNECTED_ELEMENTS = &H2000&
Const FOF_WANTNUKEWARNING = &H4000&
On Error Resume Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = Createobject("Wscript.Shell")
Set appShell = CreateObject("Shell.Application")
'create an object for the systems fonts folder
Set objFolder = appShell.Namespace(FONTFOLDER)
'make sure these paths end in a backslash
strFromPath = FixPath(strFromPath)
'get the name of the system fonts folder (C:\WINDOWS\Fonts)
strToPath = FixPath(objShell.SpecialFolders("Fonts"))
'set flags to install as quiet as possible.
flags = FOF_SILENT Or FOF_NOCONFIRMATION Or FOF_NOERRORUI Or _
FOF_NOCONFIRMMKDIR Or FOF_NOCOPYSECURITYATTRIBS
If (Not objFolder Is Nothing) Then
If objFSO.FolderExists(strFromPath) Then
Set colFiles = objFSO.GetFolder(strFromPath).Files
If colFiles.Count > 0 Then
For Each objFile In colFiles
strExt = objFSO.GetExtensionName(objFile.Name)
Select Case LCase(strExt)
Case "ttf", "otf" ' can also be used for "fon", "pfm", "pfb", "afm"
'get the complete path and filename for this font file and check if already there
strFile = strToPath & objFile.Name
If Not (objFSO.FileExists(strFile)) Then
objFolder.CopyHere strFromPath & objFile.Name, flags
End If
End Select
Next
End If
End If
End If
'cleanup objects
Set appShell = Nothing
Set colFiles = Nothing
Set objFile = Nothing
Set objFolder = Nothing
Set objFSO = Nothing
Set objShell = Nothing
End Sub
Private Function FixPath(sPath)
'small helper function to ensure a path ends in a backslash
If Len(sPath) > 0 And Right(sPath, 1) <> "\" Then
FixPath = sPath & "\"
Else
FixPath = sPath
End If
End Function
I am trying to open a doc file and save it as docx in batch mode. But MSWord is always shows up even when the visible attribute is set to false..
is there something wrong with my code ?
If Wscript.Arguments.Count <> 2 Then
Wscript.Echo "Wrong Arguments. Need 2 arguments; Filename and Output Directory."
Wscript.quit
End If
Dim objApp
Dim objDoc
Dim objFile
fileName = Wscript.Arguments(0)
outputDirectory = Wscript.Arguments(1)
Set objFSO = CreateObject( "Scripting.FileSystemObject" )
Set MyObject = GetObject(fileName)
if MyObject is Nothing then
objApp = CreateObject("Word.Application")
Else
Set objApp = MyObject.Application
End If
objApp.Visible = False
Set objFile = objFSO.GetFile(fileName)
Set objDoc = objApp.Documents.Open(fileName)
objDoc.SaveAs objFSO.BuildPath( outputDirectory, objFSO.GetBaseName( objFile ) & ".docx" ), 12
objDoc.Close
objApp.Quit
Set objDoc = Nothing
Set objApp = Nothing
I have a VBS list script to list file,with various dates. All of the files are MS Word documents but I want the AUTHOR from the document attributes (I tried googling "author" attribute not the best search).
I am after a text list of all the documents in a folder :- File name , date accessed, date created, date modified and AUTHOR. I was hoping VBS would crack it but if there is another solution out there I am open to suggestions.
On Error Resume Next
Const WINDOW_HANDLE = 0
Const BIF_EDITBOX = &H10
Const BIF_NONEWFOLDER = &H0200
Const BIF_RETURNONLYFSDIRS = &H1
Set objShell = CreateObject("Shell.Application")
Set wshShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
'**Browse For Folder To Be Processed
strPrompt = "Please select the folder to process."
intOptions = BIF_RETURNONLYFSDIRS + BIF_NONEWFOLDER + BIF_EDITBOX
strTargetPath = wshShell.SpecialFolders("MyDocuments")
strFolderPath = Browse4Folder(strPrompt, intOptions, strTargetPath)
Set objNewFile = objFSO.CreateTextFile(strFolderPath & "\filelist.txt", True)
Set objFolder = objFSO.GetFolder(strFolderPath)
Set objColFiles = objFolder.Files
For Each file In objColFiles
objNewFile.WriteLine(file.Name)
objNewFile.WriteLine(file.DateCreated)
objNewFile.WriteLine(file.DateLastAccessed)
objNewFile.WriteLine(file.DateLastModified)
Next
objNewFile.Close
'**Browse4Folder Function
Function Browse4Folder(strPrompt, intOptions, strRoot)
Dim objFolder, objFolderItem
On Error Resume Next
Set objFolder = objShell.BrowseForFolder(0, strPrompt, intOptions, strRoot)
If (objFolder Is Nothing) Then
Wscript.Quit
End If
Set objFolderItem = objFolder.Self
Browse4Folder = objFolderItem.Path
Set objFolderItem = Nothing
Set objFolder = Nothing
End Function
You'll have to go through the properties of the Word Application object.
Look here for instance how to do that.
Should be something like this:
Set oWord = CreateObject("Word.Application")
Set oDoc = oWord.Documents.Open("myWordDocument.doc")
Set sAuthor = oDoc.BuiltInDocumentProperties("Author")
This script basically goes to a folder and list all the files in that folder and output it in a txt file. Now instead of defining the folder path I want it to use the txt file that contains a bunch of folder paths in it and I want to loop that txt file. How can I do this?
Dim fso
Dim ObjFolder
Dim ObjOutFile
Dim ObjFiles
Dim ObjFile
'Creating File System Object
Set fso = CreateObject("Scripting.FileSystemObject")
'Getting the Folder Object
Set ObjFolder = fso.GetFolder("C:\Users\Susan\Desktop\Anime\ova")
'Creating an Output File to write the File Names
Set ObjOutFile = fso.CreateTextFile("C:\Users\Susan\Documents\iMacros\Macros\WindowsFiles.txt")
'Getting the list of Files
Set ObjFiles = ObjFolder.Files
'Writing Name and Path of each File to Output File
For Each ObjFile In ObjFiles
ObjOutFile.WriteLine(ObjFile.Path)
Next
ObjOutFile.Close
Ruriko, this should be a working version, i would add a check to see if the inputfile exist, i'm sure you can do that yourself.
Dim fso, ObjFolder, ObjOutFile, ObjFiles, ObjFile, outputFile, inputFileList
Const ForReading = 1, ForWriting = 2, ForAppending = 8, CreateIfNeeded = true
inputFileList = "list.txt"
outputFile = "C:\Users\Susan\Documents\iMacros\Macros\WindowsFiles.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set objTextFile = fso.OpenTextFile(inputFileList, ForReading)
Do Until objTextFile.AtEndOfStream
sFolderName = objTextFile.Readline
wscript.Echo "writing contents of " & sFolderName
writefilenames(sFolderName)
Loop
function writefilenames(sFolderName)
Set ObjFolder = fso.GetFolder(sFolderName)
If fso.FileExists(outputFile) Then
Set ObjOutFile = fso.OpenTextFile(outputFile, ForAppending)
Else
Set ObjOutFile = fso.OpenTextFile(outputFile, ForWriting, CreateIfNeeded)
End If
Set ObjFiles = ObjFolder.Files
For Each ObjFile In ObjFiles
ObjOutFile.WriteLine(ObjFile.Path)
Next
ObjOutFile.Close
end function