I want to get the exact path of the active word document. I have written the below code. The code works fine if one word document is open, but when I open a second document and run it the path shows as "My Documents". Even in the first document, if I run now it shows "My Documents". The code is:
Sub NewMenuMacro()
Dim myMenuItem As Object
Dim objIE As Object
Dim folderName
folderName = "..\.."
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fullpath
fullpath = fso.GetAbsolutePathName(Me.Application.ActiveDocument)
If fso.FileExists(fullpath) Then
Dim objFile
' fullpath = fso.GetAbsolutePathName(Me.Application.ActiveDocument)
Set objFile = fso.GetFile(fullpath)
ActiveDocument.SaveAs (objFile.path)
fullpath = fso.GetAbsolutePathName(objFile)
Else
ActiveDocument.Save
fullpath = fso.GetAbsolutePathName(Me.Application.ActiveDocument)
End If
You can just use the FullName property.
fullpath = Me.Application.ActiveDocument.FullName
Related
I have a directory of files that I want to Loop through and use part of their filename to replace text in a template doc.
For example one filename may be 'NV_AD32_city.dxf'. All files in the directory follow the same filename pattern of XX_XXXX_string.dxf, using two underscores.
I need to capture the string to the right of the first "_" and to the left of the "."so for this example that would be 'AD32_city'
How do I script to use capture that text of the active file to replace text in the template? I guess I need to create an object? But what is the object to use for the current file from a directory?
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Thx for the replies, guys. After several days of trying your code I am just not "getting it". I understand it is set up to take the part of the filename's string that I want but how do I tell the script to use the current file I am looping through? Here is my script so far. I have your code on line 20 under the Sub 'GetNewInputs'
Set fso = CreateObject("Scripting.FileSystemObject")
Option Explicit
Dim WritePath : WritePath = "S:\TempFolder\"
Dim OutFile : OutFile = "VEG_DXF-2-SHP_script-"
Dim WorkingFile : WorkingFile = GetFileContent(SelectFile())
Dim NewState, NewSection, NewArea
Dim OldState, OldSection, OldArea
Call GetNewInputs()
Call GetOldInputs()
Sub GetNewInputs()
NewState = UCase(InputBox("INPUT STATE:", _
"INPUT STATE", "SOCAL"))
NewSection = ("Section_" & InputBox("INPUT SECTION NUMBER:", _
"INPUT SECTION", "14"))
NewArea = "^[^_]+_(.*)\.dxf$"
End Sub
Private Sub GetOldInputs()
OldState = "XX"
OldSection = "_X"
OldArea = "ZZZZ"
End Sub
Function SelectFile()
SelectFile = vbNullString
Dim objShell : Set objShell = WScript.CreateObject("WScript.Shell")
Dim strMSHTA : strMSHTA = "mshta.exe ""about:" & "<" & "input type=file id=FILE>" _
&"<" & "script>FILE.click();new ActiveXObject('Scripting.FileSystemObject')" _
&".GetStandardStream(1).WriteLine(FILE.value);close();resizeTo(0,0);" & "<" & "/script>"""
SelectFile = objShell.Exec(strMSHTA).StdOut.ReadLine()
If SelectFile = vbNullString Then
WScript.Echo "No file selected or not a text file."
WScript.Quit
End If
End Function
Private Function GetFileContent(filePath)
Dim objFS, objFile, objTS
Set objFS = CreateObject("Scripting.FileSystemObject")
Set objFile = objFS.GetFile(filePath)
Set objTS = objFile.OpenAsTextStream(1, 0)
GetFileContent = objTS.Read(objFile.Size)
Set objTS = Nothing
End Function
For Each FileRefIn fso.GetFolder("S:\SOCAL\Section_14\Veg DXFs\").Files
NewFile = WorkingFile
NewFile = Replace(NewFile, OldState, NewState)
NewFile = Replace(NewFile, OldSection, NewSection)
NewFile = Replace(NewFile, OldArea, NewArea)
WriteFile NewFile, WritePath & OutFile & ".gms"
WScript.Echo NewArea
Next
Private Sub WriteFile(strLine,fileName)
On Error Resume Next
Dim objFSO, objFile
Set objFSO = CreateObject("Scripting.FileSystemObject")
Do Until IsObject(objFile)
Set objFile = objFSO.OpenTextFile(fileName, 8, True)
Loop
objFile.WriteLine strLine
objFile.Close
End Sub
Well, that’s actually two questions.
To enumerate files in a directory, you can use FileSystemObject, like this (untested)
const strFolderPath = "C:\Temp\Whatever"
set objFSO = CreateObject( "Scripting.FileSystemObject" )
set objFolder = objFSO.GetFolder( strFolderPath )
set colFiles = objFolder.Files
for each objFile in colFiles
' Do whatever you want with objFile
next
Here's the reference of those objects properties/methods.
And to extract portion of file names, you could use a regular expression.
Here’s some guide how to use'em in VBScript.
The following expression should work for you, it will capture the portion of that file names you asked for:
"^[^_]+_(.*)\.dxf$"
If you need to edit the content of the .dxf files, you will need to work within the AutoCAD VBA (Visual Basic for Applications) environment.
If that is the case, you will need to start with something like below:
GetObject("AutoCAD.Application.20")
CreateObject("AutoCAD.Application.20")
https://knowledge.autodesk.com/search-result/caas/CloudHelp/cloudhelp/2015/ENU/AutoCAD-ActiveX/files/GUID-0225808C-8C91-407B-990C-15AB966FFFA8-htm.html
** Please take note that "VBA is no longer distributed with the AutoCAD installation; it must be downloaded and installed separately. The VBA Enabler for Autodesk AutoCAD can be downloaded here."
Sub Copy_TNSNamesORA()
' Now look for SQLNET.ora file in %userprofile%\appdata\Roaming and if that exists copy the file to the
' the TNSNAMES folder
Dim fso
Dim f
Dim wshShell
Dim wshUserEnv
Dim TNSFolder
Set fso = CreateObject("Scripting.FileSystemObject")
Set WshShell = WScript.CreateObject("WScript.Shell")
Set WshUserEnv = WshShell.Environment("PROCESS")
TNSFolder = WshUserEnv("TNSNAMES")
Dim SQLOraTempFileName
Dim SQLOraLocalFileName
SQLOraTempFileName = WshUserEnv("userprofile") & "\appdata\Roaming" & "\Oracle\SQLNET.ORA"
SQLOraLocalFileName = TNSFolder & "SQLNET.ORA"
End Sub
I'm trying to create a folder in c\userprofile\appdata\roaming\oracle
named TNSNAMES by using this code. Can some one clarify for me that this code
TNSFolder = WshUserEnv("TNSNAMES") is suitable to use to create a folder?
According to the docs you create a folder by call the CreateFolder (surprise!) method of a FileSystemObject.
stolen demo code:
Function CreateFolderDemo
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateFolder("c:\New Folder") ' <-- new folder is born
CreateFolderDemo = f.Path ' <-- return folder spec (string) to caller
End Function
(Simply assigning a string containing a folder specification to a variable will copy the string but not automagically change your harddisk.)
Currently this is my script
Set oWS = WScript.CreateObject("WScript.Shell")
' Get the %userprofile% in a variable, or else it won't be recognized
userProfile = oWS.ExpandEnvironmentStrings( "%userprofile%" )
What I am trying to do is grab the current user logged in, I want it to check the directory D:\"personsuser"\Appdata\Roaming\Local to see if the folder "Local" is created, if it isn't created I want to create one via createobject in vbs. The script above from what i know grabs the current logged on user, however i'm not sure how to use this variable to create a folder.
I know i will have to incorporate something along these lines:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.CreateFolder("C:\FSO")
And or something along these lines:
Dim objNetwork
Dim userName
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objNetwork = CreateObject("WScript.Network")
userName = objNetwork.userName
If fso.driveExists("D:\" & userName & "\AppData\Local\") Then
FSO.CreateDirectory ("D:\" & userName & "\AppData\Local\")
End If
Thanks in advance, not very familiar with VBS however that is the only platform I can operate from in the environment that i'm using it.
Set oWS = WScript.CreateObject("WScript.Shell")
' Get the %userprofile% in a variable, or else it won't be recognized
userProfile = oWS.ExpandEnvironmentStrings( "%userprofile%" )
Dim objNetwork
Dim userName
Dim FSO
Dim Folder
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objNetwork = CreateObject("WScript.Network")
userName = objNetwork.userName
If NOT (FSO.FolderExists(userProfile + "\AppData\Roaming\Local")) Then
' Delete this if you don't want the MsgBox to show
MsgBox("Local folder doesn't exists, creating...")
splitString = Split(userProfile, "\")
' Create folder
MsgBox("D:\" + splitString(2) + "\AppData\Roaming\Local")
'FSO.CreateFolder(splitString(2) + "\AppData\Roaming\Local")
End If
Here you go man, this should work perfect, regards Daniel.
Here is code part from my utilty for FSO:
dim ffso
Function GetFSO
if not IsValidObject(ffso) then set ffso = CreateObject("Scripting.FileSystemObject")
Set GetFSO = ffso
End Function
sub SureDirectoryExists(ADir)
if ADir="" then exit sub
if not GetFSO().FolderExists(ADir) then
SureDirectoryExists ffso.GetParentFolderName(ADir)
ffso.CreateFolder ADir
end if
end sub
This function will create all folders in the path parameter (string).
Public Function CheckCreateFolder(path)
Dim TempPath As String
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
pos = 0
While pos < Len(path)
pos = InStr(pos + 1, path, "\")
TempPath = Left(path, pos)
If Not (FSO.FolderExists(TempPath)) Then
FSO.CreateFolder (TempPath)
End If
Wend
End Function
I am trying to create a Vbscript to go through a text file containing different URLs and navigate to each URL using WshShell.Run. I am currently getting: "Object Required: urllist" Error.
Sorry I am new to Vbscript not sure where to go from here.
The urllist.txt is stored in the same directory.
Here is what I have so far:
dim listFile
dim WshShell
dim fName
Set fso = CreateObject("Scripting.FileSystemObject")
Set listFile = fso.OpenTextFile(urllist.txt)
Set WshShell = WScript.CreateObject("WScript.Shell")
Dim fso
'do while not listFile.AtEndOfStream
fName = listFile.ReadLine()
Return = WshShell.Run("iexplore.exe " & fName, 1)
'loop
You missed quote-mark. Next line:
Set listFile = fso.OpenTextFile(urllist.txt)
Should be:
Set listFile = fso.OpenTextFile("urllist.txt")
What is the simplest way in VB6 to loop through all the files in a specified folder directory and get their names?
sFilename = Dir(sFoldername)
Do While sFilename > ""
debug.print sFilename
sFilename = Dir()
Loop
Dim fso As New FileSystemObject
Dim fld As Folder
Dim fil As File
Set fld = fso.GetFolder("C:\My Folder")
For Each fil In fld.Files
Debug.Print fil.Name
Next
Set fil = Nothing
Set fld = Nothing
Set fso = Nothing
DJ's solution is simple and effective, just throwing out another one in case you need a little more functionality that the FileSystemObject can provide (requires a reference to the Microsoft Scripting Runtime).
Dim fso As New FileSystemObject
Dim fil As File
For Each fil In fso.GetFolder("C:\").Files
Debug.Print fil.Name
Next
'For VB6 very Tricky:
'Simply get the location of all project .frm files saved in your disk/project directory
Dim CountVal As Integer
CountVal = 0
cbo.Clear
sFilename = Dir(App.Path & "\Forms\")
Do While sFilename > ""
If (Right(sFilename, 4) = ".frm") Then
cbo.List(CountVal) = Left(sFilename, (Len(sFilename) - 4))
CountVal = CountVal + 1
End If
sFilename = Dir()
Loop
create button with name = browseButton
create filelistbox with name = List1
double click on button in design
and code should look like this
Private Sub browseButton_Click()
Dim path As String
path = "C:\My Folder"
List1.path() = path
List1.Pattern = "*.txt"
End Sub
done now run it
You can use the following demo code,
Dim fso As New FileSystemObject
Dim fld As Folder
Dim file As File
Set fld = fso.GetFolder("C:\vishnu")
For Each file In fld.Files
msgbox file.Name
Next