I am making a form that the user fills out and when complete, they click a command button and the text they inputted is saved as a text file in a folder in the C: drive called Survey Results.
Currently, the user has to create the file "Survey Results" manually, and if it does not exist in the C: drive, there is an error in Word. I want some way to check if the destination exists before this error occurs and either prompt the user to create the folder or automatically create the folder.
What would I include in my while loop to check for this?
do while ()
messagebox1.open
loop
Private Sub CommandButton1_Click()
Dim FS As FileSystemObject
Set FS = New FileSystemObject
Dim MyFile As TextStream
Dim i As Integer
Dim FilePrefix As String, FileName As String, Extension As String
If CommandButton1.Enabled = True Then
FilePrefix = "C:\SurveyResults\"
Extension = ".txt"
i = 1
FileName = FilePrefix & comop & Trim(Str(i)) & Extension
Do While (FS.FileExists(FileName))
i = i + 1
FileName = FilePrefix & comop & Trim(Str(i)) & Extension
Loop
Set MyFile = FS.CreateTextFile(FileName)
MyFile.Write num1 & vbNewLine & num2 & vbNewLine & _
num3 & vbNewLine & num4 & vbNewLine & _
num5 & vbNewLine & num6 & vbNewLine & _
num7 & vbNewLine & num8 & vbNewLine & num9 & vbNewLine & num10 & vbNewLine & num11 _
& vbNewLine & num12 & vbNewLine & num13 & vbNewLine & num14 & vbNewLine _
& num15 & vbNewLine & num16 & vbNewLine & num17 & vbNewLine & num18 & vbNewLine & num19 & vbNewLine _
& num20 & vbNewLine & num21 & vbNewLine & num22 & vbNewLine & num23 & vbNewLine _
& num24 & vbNewLine & num25 & vbNewLine & num26 & vbNewLine & num27 & vbNewLine & num28 & vbNewLine _
& num29 & vbNewLine & num30 & vbNewLine & num31 & vbNewLine & num32 & vbNewLine & num33 & vbNewLine _
& com1a & vbNewLine & com1b & vbNewLine & com1c & vbNewLine & com1d & vbNewLine & com1e & vbNewLine _
& com1f & vbNewLine & com1g & vbNewLine & com1i & vbNewLine & com1j & vbNewLine & com1k & vbNewLine _
& com2a & vbNewLine & com2b & vbNewLine & com2c & vbNewLine & com2d & vbNewLine & com2e & vbNewLine _
& com2f & vbNewLine & com2g & vbNewLine _
& com3a & vbNewLine & com3b & vbNewLine & com3c & vbNewLine & com3d & vbNewLine & com3e & vbNewLine _
& com3f & vbNewLine _
& com4a & vbNewLine & com4b & vbNewLine & com4c & vbNewLine & com4d & vbNewLine & com4e & vbNewLine _
& com4f & vbNewLine & com4g & vbNewLine & com4h & vbNewLine & com4i & vbNewLine & com4j & vbNewLine & com4k & vbNewLine & com4l & vbNewLine _
& com5a & vbNewLine & com5b & vbNewLine & com5c & vbNewLine & com5d & vbNewLine & com5e & vbNewLine _
& com5f & vbNewLine & com5g & vbNewLine & com5h & vbNewLine & com5i & vbNewLine & com5j & vbNewLine _
& com6a & vbNewLine & com6b & vbNewLine & com6c & vbNewLine & com6d & vbNewLine _
& com1hb & vbNewLine & com1hd & vbNewLine _
& com1hf & vbNewLine & com1hh & vbNewLine & com1hj & vbNewLine & comop
End If
End Sub
Do something like the below snippet:
Dim FilePrefix$, fs As New Scripting.FileSystemObject
FilePrefix = "C:\SurveyResults\"
If Dir(FilePrefix, vbDirectory) <> "" Then
'directory exists
Else
'directory does not exist
fs.CreateFolder FilePrefix ' create the dir
End If
Related
Been trying to figure out if there is a way to deserialize this object below. the problem is the api returns the data in this format. There seems to be an object here called Info that is listof()..
"found=23" & vbCrLf & "info[0].Channel=0" & vbCrLf & "info[0].EndTime=2020-05-11 00:59:59" & vbCrLf & "info[0].EnteredSubtotal=0" & vbCrLf & "info[0].ExitedSubtotal=0" & vbCrLf & "info[0].RuleName=NumberStat" & vbCrLf & "info[0].StartTime=2020-05-11 00:00:00" & vbCrLf & "info[1].Channel=0" & vbCrLf & "info[1].EndTime=2020-05-11 01:59:59" & vbCrLf & "info[1].EnteredSubtotal=0" & vbCrLf & "info[1].ExitedSubtotal=0" & vbCrLf & "info[1].RuleName=NumberStat" & vbCrLf & "info[1].StartTime=2020-05-11 01:00:00" & vbCrLf & "info[2].Channel=0" & vbCrLf & "info[2].EndTime=2020-05-11 02:59:59" & vbCrLf & "info[2].EnteredSubtotal=0" & vbCrLf & "info[2].ExitedSubtotal=0" & vbCrLf & "info[2].RuleName=NumberStat" & vbCrLf & "info[2].StartTime=2020-05-11 02:00:00" & vbCrLf & "info[3].Channel=0" & vbCrLf & "info[3].EndTime=2020-05-11 03:59:59" & vbCrLf & "info[3].EnteredSubtotal=0" & vbCrLf & "info[3].ExitedSubtotal=0" & vbCrLf & "info[3].RuleName=NumberStat" & vbCrLf & "info[3].StartTime=2020-05-11 03:00:00" & vbCrLf & "info
Thanks in advance for any ideas here.
Looks like it is VBscript.
vbCrLf means new line so:
"found=23"
"info[0].Channel=0"
"info[0].EndTime=2020-05-11 00:59:59"
"info[0].EnteredSubtotal=0"
"info[0].ExitedSubtotal=0"
"info[0].RuleName=NumberStat"
"info[0].StartTime=2020-05-11 00:00:00"
"info[1].Channel=0"
"info[1].EndTime=2020-05-11 01:59:59"
"info[1].EnteredSubtotal=0"
"info[1].ExitedSubtotal=0"
"info[1].RuleName=NumberStat"
"info[1].StartTime=2020-05-11 01:00:00"
"info[2].Channel=0"
"info[2].EndTime=2020-05-11 02:59:59"
"info[2].EnteredSubtotal=0"
"info[2].ExitedSubtotal=0"
"info[2].RuleName=NumberStat"
"info[2].StartTime=2020-05-11 02:00:00"
"info[3].Channel=0"
"info[3].EndTime=2020-05-11 03:59:59"
"info[3].EnteredSubtotal=0"
"info[3].ExitedSubtotal=0"
"info[3].RuleName=NumberStat"
"info[3].StartTime=2020-05-11 03:00:00"
I think this might be useful:
How to run VBScript in .net core or .net standard project?
I have this chunk of code
With Data.Cells(rowMatch, GWECol)
.Value = Cmp.Cells(i, GWENetPr)
.AddComment
.Comment.Text Text:=UCase(Environ("UserName")) & ":" & vbNewLine _
& "Comment: " & Cmp.Cells(i, CommCol) & vbNewLine _
& "Transaction: " & Cmp.Cells(i, QRTran) & vbNewLine _
& "QR Pr: " & Cmp.Cells(i, QRPr) & vbNewLine _
& "QR WD: " & Cmp.Cells(i, QRWD) & vbNewLine _
& "QR WD All: " & Cmp.Cells(i, QRWDA) & vbNewLine _
& "QR XPr: " & Cmp.Cells(i, QRXPr) & vbNewLine _
& "QR XAll: " & Cmp.Cells(i, QRXAll) & vbNewLine _
& "GWE Pr: " & Cmp.Cells(i, GWEPr) & vbNewLine _
& "GWE All: " & Cmp.Cells(i, GWEAll) & vbNewLine _
& "GWE XPr: " & Cmp.Cells(i, GWEXPr) & vbNewLine _
& "GWE XAll: " & Cmp.Cells(i, GWEXAll)
.Comment.Shape.TextFrame.AutoSize = True
End With
Where the Cmp.Cells(i, X) refers to cells that may have #N/A error (a failed VLOOKUP).
Is it possible to have the code just take in the #N/A as a string or just leave it empty? Right now, whenever one of the cells referenced is #N/A, the chunk will fail and no comment text will be added at all.
Thanks!
You're using the default property of the cell,
Debug.Print Cmp.Cells(i, QRXAll)
For example this always refers to the cells .Value property. The .Value is actually an error type, Error 2042 which I think you could avoid by checking
CLng(Cmp.Cells(i,QRXA11))
But this will result in 2042 instead of the #N/A text.
If you want to get the string #N/A: try using Cmp.Cells(i, QRXAll).Text which relies on the cell's .Text property instead of its .Value.
Debug.Print Cmp.Cells(i, QRXAll).Text
Disclaimer: I have done some VBA programming, but I wouldn't call myself an expert.
This may be overly simplistic, but you could just assign each value to a variable and then assign the variables to the comment. If any one value is N/A, at least the rest of your values will still be assigned to the comment. I perfer this kind of solution as it ensures that a single error will not derail the entire operation.
Dim vComment As String
Dim vTransaction As String
Dim vQRPr As String
Dim vQRWD As String
' Etc.
vComment = Cmp.Cells(i, CommCol).Text
vTransaction = Cmp.Cells(i, QRTran).Text
vQRPr = Cmp.Cells(i, QRPr).Text
vQRWD = Cmp.Cells(i, QRWD).Text
' Etc.
.Comment.Text Text:=UCase(Environ("UserName")) & ":" & vbNewLine _
& "Comment: " & vComment & vbNewLine _
& "Transaction: " & vTransaction & vbNewLine _
& "QR Pr: " & vQRPr & vbNewLine _
& "QR WD: " & vQRWD & vbNewLine
' Etc.
Edited: Thanks to David for pointing out that the .Text property should be used
use IsError to check to see if the cells has #N/A
if IsError(Cmp.Cells(i, GWENetPr)) then
'give it a valid value
else
'use the value int he cell
end if
'start with statement
example
With Data.Cells(rowMatch, GWECol)
If IsError(Cmp.Cells(i, GWENetPr)) Then
.Value = "" 'or #N/A
Else
.Value = Cmp.Cells(i, GWENetPr)
End If
.AddComment
.Comment.Text Text:=UCase(Environ("UserName")) & ":" & vbNewLine _
& "Comment: " & Cmp.Cells(i, CommCol) & vbNewLine _
& "Transaction: " & Cmp.Cells(i, QRTran) & vbNewLine _
& "QR Pr: " & Cmp.Cells(i, QRPr) & vbNewLine _
& "QR WD: " & Cmp.Cells(i, QRWD) & vbNewLine _
& "QR WD All: " & Cmp.Cells(i, QRWDA) & vbNewLine _
& "QR XPr: " & Cmp.Cells(i, QRXPr) & vbNewLine _
& "QR XAll: " & Cmp.Cells(i, QRXAll) & vbNewLine _
& "GWE Pr: " & Cmp.Cells(i, GWEPr) & vbNewLine _
& "GWE All: " & Cmp.Cells(i, GWEAll) & vbNewLine _
& "GWE XPr: " & Cmp.Cells(i, GWEXPr) & vbNewLine _
& "GWE XAll: " & Cmp.Cells(i, GWEXAll)
.Comment.Shape.TextFrame.AutoSize = True
End With
You can use IIf to use a specific value if there is an error:
& "Comment: " & IIf(IsError(Cmp.Cells(i, CommCol)),"",Cmp.Cells(i, CommCol)) & vbNewLine _
When I try to write text to a file, I get an error saying "FormatException was unhandled"
Here's the code:
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Dim ChampPath As String = FolderBrowserDialog1.SelectedPath & "\League of Legends\Config\Champions"
Dim NamePath As String = ChampPath & "\" & SelectChampion.Text
Dim FilePath As String = NamePath & "\" & SelectChampion.Text & ".json"
Dim Map As String
Dim Mode As String
System.IO.Directory.CreateDirectory(NamePath)
System.IO.File.Create(FilePath).Dispose()
If (SelectMap.Text = "Any") Then
Map = "any"
ElseIf (SelectMap.Text = "Summoners Rift") Then
Map = "1"
ElseIf (SelectMap.Text = "Twisted Treeline") Then
Map = "10"
ElseIf (SelectMap.Text = "Crystal Scar") Then
Map = "8"
ElseIf (SelectMap.Text = "Proving Grounds") Then
Map = "3"
End If
If (SelectMode.Text = "Any") Then
Mode = "any"
ElseIf (SelectMode.Text = "Classic") Then
Mode = "CLASSIC"
ElseIf (SelectMode.Text = "Dominon") Then
Mode = "ODIN"
ElseIf (SelectMode.Text = "Proving Grounds") Then
Mode = "ARAM"
End If
If (System.IO.File.Exists(FilePath)) Then
Using Writer As StreamWriter = New StreamWriter(FilePath)
Writer.Write("{" & vbNewLine &
" ""champion"":""" & SelectChampion.Text & """," & vbNewLine &
" ""title"":""" & TitleBox.Text & "", " " & vbNewLine &
" ""type"":""" & TypeBox.Text & "", " " & vbNewLine &
" ""map"":""" & Map & "", " " & vbNewLine &
" ""mode"":""" & Mode & "", " " & vbNewLine &
" ""priority""" & SelectPriority.Text & "", " " & vbNewLine &
" ""blocks"":[ " & vbNewLine &
"{" & vbNewLine &
" ""type"":""starting"", " & vbNewLine &
" ""items"":[ " & vbNewLine &
"{" & vbNewLine &
" ""id"":""1001"", " & vbNewLine &
" ""count"":1 " & vbNewLine &
"}," & vbNewLine &
"{" & vbNewLine &
" ""id"":""3010"", " & vbNewLine &
" ""count"":3 " & vbNewLine &
"}" & vbNewLine &
"]" & vbNewLine &
"}," & vbNewLine &
"{" & vbNewLine &
" ""type"":""essential"", " & vbNewLine &
" ""items"":[ " & vbNewLine &
"{" & vbNewLine &
" ""id"":""3001"", " & vbNewLine &
" ""count"":1 " & vbNewLine &
"}," & vbNewLine &
"{" & vbNewLine &
" ""id"":""3089"", " & vbNewLine &
" ""count"":1 " & vbNewLine &
"}" & vbNewLine &
"]" & vbNewLine &
"}," & vbNewLine &
"{" & vbNewLine &
" ""type"":""offensive"", " & vbNewLine &
" ""items"":[ " & vbNewLine &
"{" & vbNewLine &
" ""id"":""3100"", " & vbNewLine &
" ""count"":1 " & vbNewLine &
"}," & vbNewLine &
"{" & vbNewLine &
" ""id"":""3128"", " & vbNewLine &
" ""count"":1 " & vbNewLine &
"}," & vbNewLine &
"{" & vbNewLine &
" ""id"":""3135"", " & vbNewLine &
" ""count"":1 " & vbNewLine &
"}" & vbNewLine &
"]" & vbNewLine &
"}," & vbNewLine &
"{" & vbNewLine &
" ""type"":""defensive"", " & vbNewLine &
" ""items"":[ " & vbNewLine &
"{" & vbNewLine &
" ""id"":""3140"", " & vbNewLine &
" ""count"":1 " & vbNewLine &
"}," & vbNewLine &
"{" & vbNewLine &
" ""id"":""3157"", " & vbNewLine &
" ""count"":1 " & vbNewLine &
"}" & vbNewLine &
"]" & vbNewLine &
"}" & vbNewLine &
"]" & vbNewLine &
"}")
End Using
End If
End Sub
I can't find where the error is actually coming from...
The text also needs to be formatted like it is, with the quotes and what not. Thanks for any help.
Assumed VB Net .. Better you change like this
Writer.Write("{" & vbNewLine & _
" champion : " & SelectChampion.Text & "," & vbNewLine & _
" title : " & TitleBox.Text & "," & vbNewLine & _
" type : " ........
...... etc
I am trying to write text to a file, and have it all except one error.
It says "Expression Expected"
Here's the code:
Using writer As StreamWriter = New StreamWriter(filepath)
writer.Write("[HealthBarSettings]" & vbNewLine & _
"MaxHealthTicks = 50" & vbNewLine & _
"MaxHealthMicroTicks = 100" & vbNewLine & _
"DefaultHealthPerMicroTick = 50" & vbNewLine & _
"DefaultHealthPerTick = 200" & vbNewLine & _
"DefaultHealthPerMegaTick = 1000" & vbNewLine & _
& vbNewLine & _
"TickAlpha = 200" & vbNewLine & _
"MicroTickAlpha = 140" & vbNewLine & _
"MicroTickHeight = 0.5" & vbNewLine & _
"MegaTickAlpha = 255" & vbNewLine & _
"TickThickness = 1.0" & vbNewLine & _
"MicroTickThickness = 1.0" & vbNewLine & _
"MegaTickThickness = 2.0" & vbNewLine & _
& vbNewLine & _
"UseCompression = 1" & vbNewLine & _
"GoTransparent = 1" & vbNewLine & _
The error is on line 8 were it says "& vbNewLine & _" with nothing else on the line, the first & is underlined. There's no errors on the other lines like this one.
I really hate string concatenations. Just to avoid it I would write
Dim sb = new StringBuilder(680)
sb.AppendLine("[HealthBarSettings]")
sb.AppendLine("MaxHealthTicks = 50")
sb.AppendLine("MaxHealthMicroTicks = 100")
sb.AppendLine("DefaultHealthPerMicroTick = 50")
sb.AppendLine("DefaultHealthPerTick = 200")
sb.AppendLine("DefaultHealthPerMegaTick = 1000")
sb.AppendLine()
sb.AppendLine("TickAlpha = 200")
sb.AppendLine("MicroTickAlpha = 140")
sb.AppendLine("MicroTickHeight = 0.5")
sb.AppendLine("MegaTickAlpha = 255")
sb.AppendLine("TickThickness = 1.0")
sb.AppendLine("MicroTickThickness = 1.0")
sb.AppendLine("MegaTickThickness = 2.0")
sb.AppendLine()
sb.AppendLine("UseCompression = 1")
sb.AppendLine("GoTransparent = 1")
writer.Write(sb.ToString())
I have created a StringBuilder with an initial capacity of 680 chars. (Assuming 17 lines with 40 chars each). The StringBuilder has an internal buffer where it store the characters. This buffer start with a 16 char capacity. You could call the constructor of the StringBuilder saying that you need 1K buffer. This will create the internal buffer for the requested size and, if it is large enough, the framework don't need to do a resizing operation when, adding more characters, you exceed the buffer current size.
Change line 8 to:
"DefaultHealthPerMegaTick = 1000" & vbNewLine _
& vbNewLine & _
The problem was the extra &. You don't need a concatenation operator when using _
you have used & sign twice
1. "MaxHealthTicks = 50" & vbNewLine & _
2. "MaxHealthMicroTicks = 100" & vbNewLine & _
3. "DefaultHealthPerMicroTick = 50" & vbNewLine & _
4. "DefaultHealthPerTick = 200" & vbNewLine & _
6. "DefaultHealthPerMegaTick = 1000" & vbNewLine & _
7. & vbNewLine & _
8. "TickAlpha = 200" & vbNewLine & _
9. "MicroTickAlpha = 140" & vbNewLine & _
10. "MicroTickHeight = 0.5" & vbNewLine & _
11. "MegaTickAlpha = 255" & vbNewLine & _
12. "TickThickness = 1.0" & vbNewLine & _
13. "MicroTickThickness = 1.0" & vbNewLine & _
14. "MegaTickThickness = 2.0" & vbNewLine & _
15. & vbNewLine & _
16. "UseCompression = 1" & vbNewLine & _
17. "GoTransparent = 1" & vbNewLine & _
See the last Line i mentioned... line 6 have '&' and 7 also have '&' so it used twice
and also same thing on 14 and 15 no line and no need to use if 17 no line your last line
& _
I am trying to use VBA in Excel to add conditional formatting to a column of a pivot table. The issue is that whenever the pivot table is refreshed, or a filter is changed, etc. the conditional formatting is lost. My solution was to add a macro to the pivot table update event in the workbook, which works ... kinda. It seems that when I run the code that creates the pivot table and adds the code to handle conditional formatting an error occurs but ONLY when the VBA window is NOT open. If the VBA window is open the code executes normally - despite no code changes or reference changes.
Private Sub setupConditionalFormattingForStatusColumn()
Dim thisSheetModule As vbcomponent
Dim formattingCodeString As String
On Error GoTo conditionalFormattingError
formattingCodeString = _
"Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)" & vbNewLine & _
" With Target.parent.Columns(" & harReportColumn("Status") & ")" & vbNewLine & _
" .FormatConditions.AddIconSetCondition" & vbNewLine & _
" .FormatConditions(.FormatConditions.Count).SetFirstPriority" & vbNewLine & _
vbNewLine & _
" With .FormatConditions(1)" & vbNewLine & _
" .IconSet = ActiveWorkbook.IconSets(xl4TrafficLights)" & vbNewLine & _
" .IconCriteria(1).Icon = xlIconYellowExclamation" & vbNewLine & _
vbNewLine & _
" With .IconCriteria(2) " & vbNewLine & _
" .Type = xlConditionValueNumber" & vbNewLine & _
" .value = -1" & vbNewLine & _
" .Operator = 5" & vbNewLine & _
" .Icon = xlIconGreenCircle" & vbNewLine & _
" End With" & vbNewLine & _
vbNewLine & _
" With .IconCriteria(3)" & vbNewLine & _
" .Type = xlConditionValueNumber" & vbNewLine & _
" .value = 1.05" & vbNewLine & _
" .Operator = 7" & vbNewLine & _
" .Icon = xlIconYellowCircle" & vbNewLine & _
" End With" & vbNewLine
formattingCodeString = formattingCodeString & vbNewLine & _
" With .IconCriteria(4)" & vbNewLine & _
" .Type = xlConditionValueNumber" & vbNewLine & _
" .value = 1.15" & vbNewLine & _
" .Operator = 7" & vbNewLine & _
" .Icon = xlIconRedCircleWithBorder" & vbNewLine & _
" End With" & vbNewLine & _
vbNewLine & _
" .ShowIconOnly = True" & vbNewLine & _
" End With" & vbNewLine & _
vbNewLine & _
" .HorizontalAlignment = xlCenter" & vbNewLine & _
" .VerticalAlignment = xlCenter" & vbNewLine & _
" End With" & vbNewLine & _
"End Sub"
Set thisSheetModule = ThisWorkbook.VBProject.VBComponents(harReportSheet.CodeName)
thisSheetModule.CodeModule.AddFromString formattingCodeString
Exit Sub
conditionalFormattingError:
errorLog.logError "WARNING: An error occured while applying the conditional formatting code for the ""Status"" column."
Err.Clear
Resume Next
End Sub
The line which generates the error is: thisSheetModule.CodeModule.AddFromString formattingCodeString but the error is only generated if the VBA window is closed.
Any ideas?
So I was able to find an answer to this issue. Evidently Excel does not properly initialize the codename property of newly created worksheets when the VBA window is not open (the why here is beyond me) but only when it recompiles. A work-around is to force Excel to recompile prior to any calls to the codename property. The solution which worked for me was to place the following code:
On Error Resume Next
Application.VBE.CommandBars.ActiveMenuBar.FindControl(ID:=578).Execute
On Error GoTo conditionalFormattingError
above the line beginning with Set thisSheetModule = ... . Oddly enough the line of code which forces the recompile also throws an error for me which I was able to safely ignore with the surrounding error handling.
More information can be found here: http://www.office-archive.com/2-excel/d334bf65aeafc392.htm
Hope that helps someone out there. :-)