Made a function to save a word document previously created and modified in another function, but it is sending me an error: This is not a valid file name.
This is my code:
Set obj_Word = CreateObject("Word.Application")
obj_Word.Visible = True
Set doc = obj_Word.Documents.Open("C:\Evidencias3.docx")
NombreDocumento = DataTable.Value("Preguntas","Global")
Sub SaveEvidences()
obj_Word.Visible = True
doc.SaveAs("C:\Evidencias_"& NombreDocumento &".docx")
obj_Word.Quit
Set obj_Word = Nothing
End Sub
I appreciated any help or recommended
You can try to clean out the file name before saving:
Public Function CleanFileName(ByVal sIn As String) As String
Dim sOut As String, sIllegalChars As String
sIllegalChars = "\/:*|?<>" + Chr(34)
sOut = sIn
For q = 1 To Len(sIllegalChars)
sOut = Replace(sOut, Mid(sIllegalChars, q, 1), "_")
Next
CleanFileName = sOut
End Function
Usage:
doc.SaveAs(CleanFileName("C:\Evidencias_"& NombreDocumento &".docx"))
Reference: MSDN - Naming Files, Paths, and Namespaces
Perhaps the problem is in the line:
NombreDocumento = DataTable.Value("Preguntas","Global")
Not familiar with the code, is it possible that it is returning a null value? If so, you could try to append an empty string to it:
NombreDocumento = DataTable.Value("Preguntas","Global") & ""
Either way, I would debug the code and see what the constructed filename actually is. Perhaps then it will become obvious.
I am trying to return a string from a subroutine in VBScript, but I am getting a type mismatch.
Here is the code:
main
Sub Main
Dim NumofBatches, Batch1
CStr(Batch1)
Batch1 = checkXML("Bar.xml")
End Sub
'Checks For Batch in ZoneX
Sub checkXML(sFile)
Set objFileToRead = CreateObject("Scripting.FileSystemObject").OpenTextFile("D:\Projects\Scripts\SQL\" + sFile, 1)
Dim strLine, x, y
Do While Not objFileToRead.AtEndOfStream
CStr(StrLine)
strLine = objFileToRead.ReadLine()
'String Foo
If (x > 3) Then
If (InStr(strLine, """") = 1) Then
CheckXMl = ""
Else
CheckXMl = StrLine
End If
End If
Loop
objFileToRead.Close
Set objFileToRead = Nothing
End Sub
And I am not sure of the issue, I know the system right now only gets one result from If (x > 3) Then portion, but even if it weren't I should only overwrite my result, correct?
As #omegastripes pointed out, subs don't have a return value, only functions do.
Change
Sub checkXML(sFile)
...
End Sub
to
Function checkXML(sFile)
...
End Function
See also.
I'm currently idiot-proofing a legacy VB6 program that uses an MSScriptControl. It takes a file name as input, then gets some strings defined in a Property of a Class defined in said file.
Here's the current code:
Dim oScript As New ScriptControl
With oScript
.Language = "VBSCRIPT"
.Reset
.UseSafeSubset = False
.Timeout = -1
sScriptCode = "ScriptLoadedFromSomeFileDefinedSomewhereElse" 'This variable contains the entire length of the script file
'This Len() should guard against Test:FileIsBlank
If Len(sScriptCode) = 0 Then GoTo DoTheRest
'This InStr() should guard against Test:FileDoesNotContainClassDef
If InStr(1, sScriptCode, "Class myClassName", vbTextCompare) = 0 Then GoTo DoTheRest
.AddCode sScriptCode
.AddCode "Dim myClassName"
.AddCode "Set myClassObject = New myClassName"
'These InStr()s should guard against Test:FileDoesNotContainExpectedSubs
If InStr(1, sScriptCode, "Property Get PropStringA", vbTextCompare) = 0 Then GoTo DoTheRest
sPropStringA = .Eval("myClassObject.PropStringA")
If InStr(1, sScriptCode, "Property Get PropStringB", vbTextCompare) = 0 Then GoTo DoTheRest
sPropStringB = .Eval("myClassObject.PropStringB")
'This should guard against everything else. That is, Test:FileContainsInvalidVBCode
If Err Then GoTo DoTheRest
End With
DoTheRest:
'Rest of Code
Here's the pertinent part of the input script file:
Class myClassName
Public Property Get PropStringA()
PropStringA = _
"StringA"
End Property
Public Property Get PropStringB()
PropStringB = _
"StringB,StringC,StringD,StringE"
End Property
The above is loaded into the sScriptCode variable via FileSystemObject.OpenTextFile().
The entire purpose of using ScriptControl is to get the strings defined in the file's Class Properties PropStringA and PropStringB, by instantiating the Class and using ScriptControl.Eval.
Here's my question: this (hack) works, but is there a better, more refined way for me to check that the input script actually contains the things I need, specifically a Class definition and Public Get Property(ies)? What about if the file is not blank but doesn't actually contain VB code, say, a text file?
Bonus: Should I have asked this over on CodeReview instead?
Is there a way to ask for a control property in a loop??
I need somethig like this:
For each p in control.properties
if p = "Value" then
msgbox "I Have Value Property"
elseif p = "Caption" then
msgbox "I Have Caption Property"
end if
next
It could be done somehow?
Found this code on Experts Exchange. Add a reference to TypeLib Information.
Public Enum EPType
ReadableProperties = 2
WriteableProperties = 4
End Enum
Public Function EnumerateProperties(pObject As Object, pType As EPType) As Variant
Dim rArray() As String
Dim iVal As Long
Dim TypeLib As TLI.InterfaceInfo
Dim Prop As TLI.MemberInfo
On Error Resume Next
ReDim rArray(0) As String
Set TypeLib = TLI.InterfaceInfoFromObject(pObject)
For Each Prop In TypeLib.Members
If Prop.InvokeKind = pType Then
iVal = UBound(rArray)
rArray(iVal) = UCase$(Prop.Name)
ReDim Preserve rArray(iVal + 1) As String
End If
Next
ReDim Preserve rArray(UBound(rArray) - 1) As String
EnumerateProperties = rArray
End Function
You can ask for a list of the readable, or writeable properties.
Bonus, ask if a specific property exists.
Public Function DoesPropertyExist(pObject As Object, ByVal _
PropertyName As String, pType As EPType) As Boolean
Dim Item As Variant
PropertyName = UCase$(PropertyName)
For Each Item In EnumerateProperties(pObject, pType)
If Item = PropertyName Then
DoesPropertyExist = True
Exit For
End If
Next
End Function
Beaner has given an excellent direct answer to the question you have asked.
I'm guessing what you might be trying to do. Perhaps you're trying to get the "text" from a control but you don't know the type of the control at runtime. You could consider something like this, which tries a number of hard-coded property names in turn until something works.
Function sGetSomeText(ctl As Object) As String
On Error Resume Next
sGetSomeText = ctl.Text
If Err = 0 Then Exit Function
sGetSomeText = ctl.Caption
If Err = 0 Then Exit Function
sGetSomeText = ctl.Value
If Err = 0 Then Exit Function
sGetSomeText = "" 'Nothing worked '
End Function
Another approach would be to check the type of the control at runtime. You can use
If TypeName(ctl) = "whatever" or
If TypeOf ctl Is whatever.
Then you could switch to code for specific control types that definitely have the Text property, etc.
I'm not sure what you're hoping to accomplish, but I'm pretty sure VB6 does not support what you're talking about. You could try something like this:
If control.Value Is Not Nothing Then
msgbox "I Have Value Property"
Else If control.Caption Is Not Nothing Then
msgbox "I Have Caption Property"
See if that accomplishes what you're looking to do.
I've inherited a large VB6 app at my current workplace. I'm kinda learning VB6 on the job and there are a number of problems I'm having. The major issue at the moment is I can't figure out how to check if a key exists in a Collection object. Can anyone help?
My standard function is very simple. This will work regardless of the element type, since it doesn't bother doing any assignment, it merely executes the collection property get.
Public Function Exists(ByVal oCol As Collection, ByVal vKey As Variant) As Boolean
On Error Resume Next
oCol.Item vKey
Exists = (Err.Number = 0)
Err.Clear
End Function
#Mark Biek Your keyExists closely matches my standard Exists() function. To make the class more useful for COM-exposed collections and checking for numeric indexes, I'd recommend changing sKey and myCollection to not be typed. If the function is going to be used with a collection of objects, 'set' is required (on the line where val is set).
EDIT: It was bugging me that I've never noticed different requirements for an object-based and value-based Exists() function. I very rarely use collections for non-objects, but this seemed such a perfect bottleneck for a bug that would be so hard to track down when I needed to check for existence. Because error handling will fail if an error handler is already active, two functions are required to get a new error scope. Only the Exists() function need ever be called:
Public Function Exists(col, index) As Boolean
On Error GoTo ExistsTryNonObject
Dim o As Object
Set o = col(index)
Exists = True
Exit Function
ExistsTryNonObject:
Exists = ExistsNonObject(col, index)
End Function
Private Function ExistsNonObject(col, index) As Boolean
On Error GoTo ExistsNonObjectErrorHandler
Dim v As Variant
v = col(index)
ExistsNonObject = True
Exit Function
ExistsNonObjectErrorHandler:
ExistsNonObject = False
End Function
And to verify the functionality:
Public Sub TestExists()
Dim c As New Collection
Dim b As New Class1
c.Add "a string", "a"
c.Add b, "b"
Debug.Print "a", Exists(c, "a") ' True '
Debug.Print "b", Exists(c, "b") ' True '
Debug.Print "c", Exists(c, "c") ' False '
Debug.Print 1, Exists(c, 1) ' True '
Debug.Print 2, Exists(c, 2) ' True '
Debug.Print 3, Exists(c, 3) ' False '
End Sub
I've always done it with a function like this:
public function keyExists(myCollection as collection, sKey as string) as Boolean
on error goto handleerror:
dim val as variant
val = myCollection(sKey)
keyExists = true
exit sub
handleerror:
keyExists = false
end function
As pointed out by Thomas, you need to Set an object instead of Let. Here's a general function from my library that works for value and object types:
Public Function Exists(ByVal key As Variant, ByRef col As Collection) As Boolean
'Returns True if item with key exists in collection
On Error Resume Next
Const ERR_OBJECT_TYPE As Long = 438
Dim item As Variant
'Try reach item by key
item = col.item(key)
'If no error occurred, key exists
If Err.Number = 0 Then
Exists = True
'In cases where error 438 is thrown, it is likely that
'the item does exist, but is an object that cannot be Let
ElseIf Err.Number = ERR_OBJECT_TYPE Then
'Try reach object by key
Set item = col.item(key)
'If an object was found, the key exists
If Not item Is Nothing Then
Exists = True
End If
End If
Err.Clear
End Function
As also advised by Thomas, you can change the Collection type to Object to generalize this. The .Item(key) syntax is shared by most collection classes, so that might actually be useful.
EDIT Seems like I was beaten to the punch somewhat by Thomas himself. However for easier reuse I personally prefer a single function with no private dependencies.
Using the error handler to catch cases when the key does not exists in the Collection can make debugging with "break on all errors" option quite annoying. To avoid unwanted errors I quite often create a class which has the stored objects in a Collection and all keys in a Dictionary. Dictionary has exists(key) -function so I can call that before trying to get an object from the collection. You can only store strings in a Dictionary, so a Collection is still needed if you need to store objects.
The statement "error handling will fail if an error handler is already active" is only partly right.
You can have multiple error handlers within your routine.
So, one could accommodate the same functionality in only one function.
Just rewrite your code like this:
Public Function Exists(col, index) As Boolean
Dim v As Variant
TryObject:
On Error GoTo ExistsTryObject
Set v = col(index)
Exists = True
Exit Function
TryNonObject:
On Error GoTo ExistsTryNonObject
v = col(index)
Exists = True
Exit Function
ExistsTryObject:
' This will reset your Err Handler
Resume TryNonObject
ExistsTryNonObject:
Exists = False
End Function
However, if you were to only incorporate the code in the TryNonObject section of the routine, this would yield the same information.
It will succeed for both Objects, and non-objects.
It will speed up your code for non-objects, however, since you would only have to perform one single statement to assert that the item exists within the collection.
Better solution would be to write a TryGet function. A lot of the time you are going to be checking exists, and then getting the item. Save time by doing it at the same time.
public Function TryGet(key as string, col as collection) as Variant
on error goto errhandler
Set TryGet= col(key)
exit function
errhandler:
Set TryGet = nothing
end function
see
http://www.visualbasic.happycodings.com/Other/code10.html
the implementation here has the advantage of also optionally returning the found element, and works with object/native types (according to the comments).
reproduced here since the link is no longer available:
Determine if an item exists in a collection
The following code shows you how to determine if an item exists within a collection.
Option Explicit
'Purpose : Determines if an item already exists in a collection
'Inputs : oCollection The collection to test for the existance of the item
' vIndex The index of the item.
' [vItem] See Outputs
'Outputs : Returns True if the item already exists in the collection.
' [vItem] The value of the item, if it exists, else returns "empty".
'Notes :
'Example :
Function CollectionItemExists(vIndex As Variant, oCollection As Collection, Optional vItem As Variant) As Boolean
On Error GoTo ErrNotExist
'Clear output result
If IsObject(vItem) Then
Set vItem = Nothing
Else
vItem = Empty
End If
If VarType(vIndex) = vbString Then
'Test if item exists
If VarType(oCollection.Item(CStr(vIndex))) = vbObject Then
'Return an object
Set vItem = oCollection.Item(CStr(vIndex))
Else
'Return an standard variable
vItem = oCollection.Item(CStr(vIndex))
End If
Else
'Test if item exists
If VarType(oCollection.Item(Int(vIndex))) = vbObject Then
'Return an object
Set vItem = oCollection.Item(Int(vIndex))
Else
'Return an standard variable
vItem = oCollection.Item(Int(vIndex))
End If
End If
'Return success
CollectionItemExists = True
Exit Function
ErrNotExist:
CollectionItemExists = False
On Error GoTo 0
End Function
'Demonstration routine
Sub Test()
Dim oColl As New Collection, oValue As Variant
oColl.Add "red1", "KEYA"
oColl.Add "red2", "KEYB"
'Return the two items in the collection
Debug.Print CollectionItemExists("KEYA", oColl, oValue)
Debug.Print "Returned: " & oValue
Debug.Print "-----------"
Debug.Print CollectionItemExists(2, oColl, oValue)
Debug.Print "Returned: " & oValue
'Should fail
Debug.Print CollectionItemExists("KEYC", oColl, oValue)
Debug.Print "Returned: " & oValue
Set oColl = Nothing
End Sub
See more at: https://web.archive.org/web/20140723190623/http://visualbasic.happycodings.com/other/code10.html#sthash.MlGE42VM.dpuf
While looking for a function like this i designed it as following.
This should work with objects and non-objects without assigning new variables.
Public Function Exists(ByRef Col As Collection, ByVal Key) As Boolean
On Error GoTo KeyError
If Not Col(Key) Is Nothing Then
Exists = True
Else
Exists = False
End If
Exit Function
KeyError:
Err.Clear
Exists = False
End Function