I developed a macro to save attached files from selected emails with a subject depending on the body.
I would like to make the macro select the emails instead of doing it manually.
Goal: Select emails depending on their subject and an specific date range.
Filter mails received in a specified date range which corresponds with subject "Ordenes" and come from "ordenes#ordenes.com". This must be done without reading every single email on the inbox folder as I do not have the option of moving historical ones to another folder (shared email).
Select the mails that match the previous step and then call a macro called "SaveAttachements".
I've been checking Items.Restrict, Items.Find, Explorer.Selection, Explorer.AddToSelection but I don't seem to be getting the right concept.
You can filter (select) emails with .Restrict, which allows multiple conditions.
Option Explicit
Private Sub restrict_SenderEmailAddress_Subject_DateRangeRecent()
Dim itms As Items
Dim resItms As Items
Dim itm As Object
Dim srchSenderEmailAddress As String
Dim srchSubject As String
Dim dateRangeDays As Long
Dim srchDatePeriod As String
Dim strFilterBuild As String
Dim resItmsBuild As Items
Dim strFilter As String
Dim i As Long
Set itms = Session.GetDefaultFolder(olFolderInbox).Items
'For i = 1 To itms.Count
' Debug.Print itms(i).SenderEmailAddress
'Next
srchSenderEmailAddress = "ordenes#ordenes.com"
' If you cannot get the quotes right all at once, build the filter.
strFilterBuild = "[SenderEmailAddress] = '" & srchSenderEmailAddress & "'"
Debug.Print strFilterBuild
Set resItmsBuild = itms.Restrict(strFilterBuild)
If resItmsBuild.Count = 0 Then
Debug.Print "No " & srchSenderEmailAddress & " email."
'MsgBox "No " & srchSenderEmailAddress & " email."
Exit Sub
End If
srchSubject = "Ordenes"
strFilterBuild = strFilterBuild & " And [Subject] = '" & srchSubject & "'"
Debug.Print strFilterBuild
Set resItmsBuild = itms.Restrict(strFilterBuild)
If resItmsBuild.Count = 0 Then
Debug.Print "No " & srchSenderEmailAddress & " email with subject " & srchSubject
'MsgBox "No " & srchSenderEmailAddress & " email with subject " & srchSubject
Exit Sub
End If
' adjust as needed
dateRangeDays = 1400
srchDatePeriod = Format(Date - dateRangeDays, "yyyy-mm-dd")
'Debug.Print srchDatePeriod
strFilterBuild = strFilterBuild & " And [ReceivedTime] > '" & srchDatePeriod & "'"
Debug.Print strFilterBuild
Set resItmsBuild = itms.Restrict(strFilterBuild)
resItmsBuild.sort "[ReceivedTime]", True
If resItmsBuild.Count = 0 Then
Debug.Print "No " & srchSenderEmailAddress & " email with subject " & srchSubject & " in the last " & dateRangeDays & " days."
'MsgBox "No " & srchSenderEmailAddress & " email with subject " & srchSubject & " in the last " & datePeriodDays & " days."
Exit Sub
End If
' This should match the final strFilterBuild to confirm it can be done all at once.
strFilter = "[SenderEmailAddress] = '" & srchSenderEmailAddress & "' And [Subject] = '" & srchSubject & "' And [ReceivedTime] > '" & srchDatePeriod & "'"
Debug.Print strFilter
Set resItms = itms.Restrict(strFilter)
resItms.sort "[ReceivedTime]", True
If resItms.Count = 0 Then
MsgBox "No " & srchSubject & " email on " & srchDatePeriod
End If
For i = 1 To resItms.Count
Debug.Print resItms(i).ReceivedTime & ": " & resItms(i).Subject
'SaveAttachments resItms(i)
Next
End Sub
I've created this 2 player game called Go and I've made it so that the statistics from the game is recorded in a text file. If the same 2 players play each other more than once, their game will be recorded in the same text file on the next line.
I have done all of that, but now I want the previous games to be displayed on screen so that the players can see the scores from previous matches. I don't want the final line to be displayed as that is the score from the game that has just finished. Here's my code so far:
Dim file As System.IO.StreamWriter
'Imports the data from previous forms to form 3
handikomi = Form1.handi_komi
prisonerB = Form2.prisonerB
prisonerW = Form2.prisonerW
bpass = Form2.bpass
wpass = Form2.wpass
bstones = Form2.bstones
wstones = Form2.wstones
btotalscore = prisonerB + handikomi(0, 2)
wtotalscore = prisonerW + handikomi(1, 2)
If btotalscore > wtotalscore Then
winnerlbl.Text = (handikomi(0, 0) & " IS THE WINNER!")
ElseIf wtotalscore > btotalscore Then
winnerlbl.Text = (handikomi(1, 0) & " IS THE WINNER!")
End If
file = My.Computer.FileSystem.OpenTextFileWriter("F:\My Go project flood fill2\Text files\" & handikomi(0, 0) & " VS " & handikomi(1, 0) & ".txt", True)
'Displays statistics from current match
file.WriteLine("BLACK" & "," & "WHITE" & "," & "Total Score" & "," & btotalscore & "," & wtotalscore & "," & "Prisoners" & "," & prisonerB & "," & prisonerW & "," & "Passes" & "," & bpass & "," & wpass & "," & "Stones" & "," & bstones & "," & wstones)
file.Close()
breakdwnlbl.Text = " BLACK WHITE"
breakdwnlbl.Text = (breakdwnlbl.Text & vbNewLine & "Total Score" & " " & btotalscore & " " & wtotalscore)
breakdwnlbl.Text = (breakdwnlbl.Text & vbNewLine & "Prisoners" & " " & prisonerB & " " & prisonerW)
breakdwnlbl.Text = (breakdwnlbl.Text & vbNewLine & "Passes" & " " & bpass & " " & wpass)
breakdwnlbl.Text = (breakdwnlbl.Text & vbNewLine & "Stones" & " " & bstones & " " & wstones)
Dim data As String 'to hold value of file line
Dim filename As String 'declare file
filename = "F:\My Go project flood fill2\Text files\" & handikomi(0, 0) & " VS " & handikomi(1, 0) & ".txt" 'path to file on system
FileOpen(1, filename, OpenMode.Input) 'open file for reading
'try amend
Do While Not EOF(1)
data = LineInput(1)
MsgBox(data)
Loop
I think that I shouldn't be using EOF for this case, but I don't know what else to use as I'm still a beginner. I appreciate any help!
Wouldn't it be easier to read all lines and just skip the last one:
Dim allLines() As String = File.ReadAllLines(filename)
Dim allButLast = allLines.Take(allLines.Length - 1)
The variable allButLast is an IEnumerable(Of String) containing all the lines of the file, except for the last one.
Update:
Here's an example to show each line in a MessageBox:
For Each line As String In allButLast
MessageBox.Show(line)
Next
I've created a macro that's meant to created a lump of CSS & HTML from a set of values in each sheet of a spreadsheet.
It's a little untidy as I created the function to write it from one sheet first as a proof of concept, and then updated it.
It doesn't throw any obvious errors, but the output varies, sometimes it shows the same thing both times, and then depending on where I've got debug MsgBoxs or watches in VBA seems to alter the output.
Any ideas what on earth i'm doing wrong?
Sub createCode()
Dim myWorkbook As Workbook
Dim mySheet As Worksheet
Set myWorkbook = Application.ActiveWorkbook
For Each mySheet In myWorkbook.Worksheets
Dim bannerCount As Integer
Dim BannerCollection() As Banner
Dim r As Range
Dim lastRow, lastCol
Dim allCells As Range
bannerCount = 0
lastCol = mySheet.Range("a2").End(xlToRight).Column
lastRow = mySheet.Range("a2").End(xlDown).Row
Set allCells = mySheet.Range("a2", mySheet.Cells(lastRow, lastCol))
' MsgBox (mySheet.Name)
' MsgBox ("lastRow:" & lastRow & "lastCol:" & lastCol)
ReDim BannerCollection(allCells.Rows.Count)
For Each r In allCells.Rows
Dim thisBanner As Banner
thisBanner.imagePath = ""
thisBanner.retImagePath = ""
thisBanner.bannerTitle = ""
thisBanner.urlPath = ""
bannerCount = bannerCount + 1
' MsgBox (bannerCount)
thisBanner.imagePath = Cells(r.Row, 2).Value
thisBanner.retImagePath = Cells(r.Row, 3).Value
thisBanner.bannerTitle = Cells(r.Row, 4).Value
thisBanner.urlPath = Cells(r.Row, 5).Value
'MsgBox (Cells(r.Row, 2).Value)
'MsgBox (Cells(r.Row, 3).Value)
'MsgBox (Cells(r.Row, 4).Value)
'MsgBox (Cells(r.Row, 5).Value)
BannerCollection(bannerCount - 1) = thisBanner
Next r
Dim i As Variant
Dim retinaCSS, imgCSS, firstBannerCode, otherBannersCode, bannerTracking As String
retinaCSS = ""
imgCSS = ""
firstBannerCode = ""
otherBannersCode = ""
bannerTracking = ""
For i = 0 To bannerCount - 1
bannerTracking = BannerCollection(i).bannerTitle
bannerTracking = Replace(bannerTracking, " ", "+")
bannerTracking = Replace(bannerTracking, "&", "And")
bannerTracking = Replace(bannerTracking, "%", "PC")
bannerTracking = Replace(bannerTracking, "!", "")
bannerTracking = Replace(bannerTracking, "£", "")
bannerTracking = Replace(bannerTracking, ",", "")
bannerTracking = Replace(bannerTracking, "'", "")
bannerTracking = Replace(bannerTracking, "#", "")
bannerTracking = Replace(bannerTracking, ".", "")
retinaCSS = retinaCSS & "#sliderTarget .banner-" & i + 1 & "{background-image: url('/assets/static/" & BannerCollection(i).retImagePath & "');}" & vbNewLine
imgCSS = imgCSS & "#sliderTarget .banner-" & i + 1 & "{background-image: url('/assets/static/" & BannerCollection(i).imagePath & "');}" & vbNewLine
If i = 0 Then
firstBannerCode = firstBannerCode & "<div class=" & Chr(34) & "banner banner-" & i + 1 & " staticBanner" & Chr(34) & ">" & vbNewLine
firstBannerCode = firstBannerCode & "" & vbNewLine
firstBannerCode = firstBannerCode & "</div>" & vbNewLine
Else
otherBannersCode = otherBannersCode & "<div class=" & Chr(34) & "banner banner-" & i + 1 & " staticBanner" & Chr(34) & ">" & vbNewLine
otherBannersCode = otherBannersCode & "" & vbNewLine
otherBannersCode = otherBannersCode & "</div>" & vbNewLine
End If
' MsgBox (BannerCollection(i).retImagePath & vbNewLine & BannerCollection(i).imagePath & vbNewLine & BannerCollection(i).bannerTitle & vbNewLine & BannerCollection(i).urlPath)
Next i
CodeString = ""
CodeString = CodeString & "<style type=" & Chr(34) & "text/css" & Chr(34) & ">" & vbNewLine
CodeString = CodeString & "/* Banners */" & vbNewLine
CodeString = CodeString & imgCSS
CodeString = CodeString & "/* Retina Banners */" & vbNewLine
CodeString = CodeString & "#media only screen and (-webkit-min-device-pixel-ratio: 2) {" & vbNewLine
CodeString = CodeString & retinaCSS
CodeString = CodeString & "}" & vbNewLine
CodeString = CodeString & "</style>" & vbNewLine
CodeString = CodeString & "<div id=" & Chr(34) & "sliderTarget" & Chr(34) & " class=" & Chr(34) & "slides" & Chr(34) & ">" & vbNewLine
CodeString = CodeString & firstBannerCode
CodeString = CodeString & "</div>" & vbNewLine
CodeString = CodeString & "<script id=" & Chr(34) & "sliderTemplate" & Chr(34) & " type=" & Chr(34) & "text/template" & Chr(34) & ">" & vbNewLine
CodeString = CodeString & otherBannersCode
CodeString = CodeString & "</script>"
FilePath = Application.DefaultFilePath & "\" & mySheet.Name & "code.txt"
Open FilePath For Output As #2
Print #2, CodeString
Close #2
MsgBox ("code.txt contains:" & CodeString)
MsgBox (Application.DefaultFilePath & "\" & mySheet.Name & "code.txt")
Erase BannerCollection
Next mySheet
End Sub
and here is the Banner type:
Public Type Banner
imagePath As String
retImagePath As String
urlPath As String
bannerTitle As String
End Type
I ended up doing a bit of a code review (oops spent too much time on the Code Review site). I'll post this here in addition to #Jeeped answer in case you get some value from it.
Option Explicit
You should specify Option Explicit at the top of each code module. What this does is tell the VBA compiler to check that every variable that you are trying to use has been declared (i.e. you've got Dim blah as String, Public blah as String or Private blah as String for each blah you're using).
If you attempt to use a variable which hasn't been declared, the compiler will give you a compilation error where the first problem occurs. This helps if you mistype a variable name, otherwise the compiler will think you are talking about something new.
Adding this to the top of your code requires a couple of declarations in your code but nothing major.
Multiple variable declaration on a single line
Don't do it. You have the following line: Dim retinaCSS, imgCSS, firstBannerCode, otherBannersCode, bannerTracking As String which declares 5 variables. The first 4 are declared as variants and the last one is a String. Now your code may work like this but you were probably expecting all 5 to be Strings. Other languages I believe do operate this way but VBA doesn't.
Declare them separately like:
Dim retinaCSS As String
Dim imgCSS As String
Dim firstBannerCode As String
Dim otherBannersCode As String
Dim bannerTracking As String
Don't initialise variables unnecessarily
I see code like:
CodeString = ""
CodeString = CodeString & "<style type=" & Chr(34) & "text/css" & Chr(34) & ">" & vbNewLine
Now the problem with this is that you're assigning the empty string value to CodeString but then you are immediately assigning something else to it in the very next line. The risk is that you might try to use a variable before you have assigned something to it. This isn't a risk for the string type since it implicitly assigned an empty string value when it is created.
You can safely remove the first assignment to it. The danger could come from object references. Say if you have a reference to a worksheet but do not assign a worksheet to the variable before you try to use it. In any case you want to make sure that your variable has the required value before you attempt to use the value it holds.
Use Collection instead of an array
The array code is cumbersome and inflexible. VBA has a simple collection type which allows you to add and remove items to and from it without having to declare a fixed size.
You can also iterate through the contents using a For Each loop.
Here is the code I'm recommending:
Dim BannerCollection As Collection
Set BannerCollection = New Collection
' ...
For Each r In allCells.Rows
Dim thisBanner As Banner
Set thisBanner = New Banner
' ...
BannerCollection.Add thisBanner
Next r
' ...
Dim b As Banner
For Each b In BannerCollection
' do something with the banner.
Next
Now to do this, Banner must be a Class not a Type. I think it makes life a lot easier though.
Split a big method up into single purpose methods.
For instance I extracted a method as follows:
Private Function UrlEncode(ByVal text As String) As String
text = Replace(text, " ", "+")
text = Replace(text, "&", "And")
text = Replace(text, "%", "PC")
text = Replace(text, "!", "")
text = Replace(text, "£", "")
text = Replace(text, ",", "")
text = Replace(text, "'", "")
text = Replace(text, "#", "")
text = Replace(text, ".", "")
UrlEncode = text
End Function
Now this can be referenced like bannerTracking = UrlEncode(b.bannerTitle).
You are setting allCells to a distinct range of cells correctly.
Set allCells = mySheet.Range("a2", mySheet.Cells(lastRow, lastCol))
Then you loop through each row in the allCells range.
For Each r In allCells.Rows
But when you actually go to use r, it is only to use the row number.
thisBanner.imagePath = Cells(r.Row, 2).Value
r.Row is a number between 1 and 1,048,576, nothing more. There is no guarantee that Cells(r.Row, 2).Value refers to something on mySheet; only that whatever worksheet it is coming from it will using whatever worksheet's row number that corresponds to r.row. You need to define some parentage. An With ... End With block within the For ... Next and properly annotated .Range and .Cell references should suffice.
Sub createCode()
Dim myWorkbook As Workbook
Dim mySheet As Worksheet
Dim bannerCount As Integer
Dim BannerCollection() As Banner
Dim r As Range
Dim lastRow, lastCol
Dim allCells As Range
Set myWorkbook = Application.ActiveWorkbook
For Each mySheet In myWorkbook.Worksheets
With mySheet
'declare your vars outside the loop and zero/null then here if necessary.
bannerCount = 0
lastCol = .Range("a2").End(xlToRight).Column
lastRow = .Range("a2").End(xlDown).Row
Set allCells = .Range("a2", .Cells(lastRow, lastCol))
' MsgBox (mySheet.Name)
' MsgBox ("lastRow:" & lastRow & "lastCol:" & lastCol)
ReDim BannerCollection(allCells.Rows.Count)
For Each r In allCells.Rows
Dim thisBanner As Banner
thisBanner.imagePath = ""
thisBanner.retImagePath = ""
thisBanner.bannerTitle = ""
thisBanner.urlPath = ""
bannerCount = bannerCount + 1
' MsgBox (bannerCount)
thisBanner.imagePath = .Cells(r.Row, 2).Value
thisBanner.retImagePath = .Cells(r.Row, 3).Value
thisBanner.bannerTitle = .Cells(r.Row, 4).Value
thisBanner.urlPath = .Cells(r.Row, 5).Value
'MsgBox (.Cells(r.Row, 2).Value)
'MsgBox (.Cells(r.Row, 3).Value)
'MsgBox (.Cells(r.Row, 4).Value)
'MsgBox (.Cells(r.Row, 5).Value)
BannerCollection(bannerCount - 1) = thisBanner
Next r
Dim i As Variant
Dim retinaCSS, imgCSS, firstBannerCode, otherBannersCode, bannerTracking As String
retinaCSS = ""
imgCSS = ""
firstBannerCode = ""
otherBannersCode = ""
bannerTracking = ""
For i = 0 To bannerCount - 1
bannerTracking = BannerCollection(i).bannerTitle
bannerTracking = Replace(bannerTracking, " ", "+")
bannerTracking = Replace(bannerTracking, "&", "And")
bannerTracking = Replace(bannerTracking, "%", "PC")
bannerTracking = Replace(bannerTracking, "!", "")
bannerTracking = Replace(bannerTracking, "£", "")
bannerTracking = Replace(bannerTracking, ",", "")
bannerTracking = Replace(bannerTracking, "'", "")
bannerTracking = Replace(bannerTracking, "#", "")
bannerTracking = Replace(bannerTracking, ".", "")
retinaCSS = retinaCSS & "#sliderTarget .banner-" & i + 1 & "{background-image: url('/assets/static/" & BannerCollection(i).retImagePath & "');}" & vbNewLine
imgCSS = imgCSS & "#sliderTarget .banner-" & i + 1 & "{background-image: url('/assets/static/" & BannerCollection(i).imagePath & "');}" & vbNewLine
If i = 0 Then
firstBannerCode = firstBannerCode & "<div class=" & Chr(34) & "banner banner-" & i + 1 & " staticBanner" & Chr(34) & ">" & vbNewLine
firstBannerCode = firstBannerCode & "" & vbNewLine
firstBannerCode = firstBannerCode & "</div>" & vbNewLine
Else
otherBannersCode = otherBannersCode & "<div class=" & Chr(34) & "banner banner-" & i + 1 & " staticBanner" & Chr(34) & ">" & vbNewLine
otherBannersCode = otherBannersCode & "" & vbNewLine
otherBannersCode = otherBannersCode & "</div>" & vbNewLine
End If
' MsgBox (BannerCollection(i).retImagePath & vbNewLine & BannerCollection(i).imagePath & vbNewLine & BannerCollection(i).bannerTitle & vbNewLine & BannerCollection(i).urlPath)
Next i
CodeString = ""
CodeString = CodeString & "<style type=" & Chr(34) & "text/css" & Chr(34) & ">" & vbNewLine
CodeString = CodeString & "/* Banners */" & vbNewLine
CodeString = CodeString & imgCSS
CodeString = CodeString & "/* Retina Banners */" & vbNewLine
CodeString = CodeString & "#media only screen and (-webkit-min-device-pixel-ratio: 2) {" & vbNewLine
CodeString = CodeString & retinaCSS
CodeString = CodeString & "}" & vbNewLine
CodeString = CodeString & "</style>" & vbNewLine
CodeString = CodeString & "<div id=" & Chr(34) & "sliderTarget" & Chr(34) & " class=" & Chr(34) & "slides" & Chr(34) & ">" & vbNewLine
CodeString = CodeString & firstBannerCode
CodeString = CodeString & "</div>" & vbNewLine
CodeString = CodeString & "<script id=" & Chr(34) & "sliderTemplate" & Chr(34) & " type=" & Chr(34) & "text/template" & Chr(34) & ">" & vbNewLine
CodeString = CodeString & otherBannersCode
CodeString = CodeString & "</script>"
FilePath = Application.DefaultFilePath & "\" & mySheet.Name & "code.txt"
Open FilePath For Output As #2
Print #2, CodeString
Close #2
MsgBox ("code.txt contains:" & CodeString)
MsgBox (Application.DefaultFilePath & "\" & mySheet.Name & "code.txt")
Erase BannerCollection
End With
Next mySheet
End Sub
the below code is run from a double click event on a listbox that copies the selected file to the selected node directory on a treeview then adds the selected text as a child node.
It appears to work fine however when the program is closed and then re-opened its not showing the child node.
Any pointers........
Dim Copy2 = aMailbox & tvProgress.SelectedNode.Text & "\" & lstRequired.Text
Dim Copy1 = rPath & "\" & lstRequired.Text
If File.Exists(Copy2) Then
MsgBox("File already added. Please edit from the view above", MsgBoxStyle.OkOnly, "Lynx Control Panel")
Exit Sub
End If
If File.Exists(Copy1) Then
File.Copy(Copy1, Copy2)
tvProgress.SelectedNode.Nodes.Add(lstRequired.Text)
tvProgress.ExpandAll()
Else
MsgBox("This file no longer exists in your Lynx Repository. Please select another", MsgBoxStyle.OkOnly, "Lynx Control Panel")
Exit Sub
End If
The below code is taken entirely from a doubleclick event of the 1st listbox
Dim n As Integer
Dim i As Integer = lstPlanned.SelectedIndex
If lstPlanned.SelectedItems.Count = 0 Then Exit Sub
For n = 0 To UBound(AllDetails)
If AllDetails(n).uName & " - " & AllDetails(n).uCode & " - " & AllDetails(n).uOps = lstPlanned.SelectedItem Then
If Not My.Computer.FileSystem.DirectoryExists(zMailbox & AllDetails(n).uFile) Then
MsgBox("No files located for " & vbNewLine & (AllDetails(n).uName & " (" & AllDetails(n).uCode) & ")" & vbNewLine & " " & vbNewLine & "Please try another...", MsgBoxStyle.OkOnly, "Lynx Control Panel")
Exit Sub
End If
System.IO.Directory.CreateDirectory(aMailbox & "\" & AllDetails(n).uName & " - " & AllDetails(n).uCode & " - " & AllDetails(n).uOps)
For Each f In Directory.GetFiles(zMailbox & AllDetails(n).uFile, "*.dbf")
If File.Exists(f) Then
File.Copy(f, Path.Combine(aMailbox & "\" & AllDetails(n).uName & " - " & AllDetails(n).uCode & " - " & AllDetails(n).uOps, Path.GetFileName(f)), True)
End If
Next
For Each f In Directory.GetFiles(zMailbox & AllDetails(n).uFile, "*.ini", SearchOption.AllDirectories)
If File.Exists(f) Then
File.Copy(f, Path.Combine(aMailbox & "\" & AllDetails(n).uName & " - " & AllDetails(n).uCode & " - " & AllDetails(n).uOps, Path.GetFileName(f)), True)
End If
Next
For Each f In Directory.GetFiles(zMailbox & AllDetails(n).uFile, "*.txt", SearchOption.AllDirectories)
If File.Exists(f) Then
File.Copy(f, Path.Combine(aMailbox & "\" & AllDetails(n).uName & " - " & AllDetails(n).uCode & " - " & AllDetails(n).uOps, Path.GetFileName(f)), True)
End If
Next
tvProgress.Nodes.Remove(rN)
tvProgress.Nodes.Insert(0, rN)
tvProgress.Nodes.Add(New TreeNode(AllDetails(n).uName & " - " & AllDetails(n).uCode & " - " & AllDetails(n).uOps))
If i >= 0 And i < lstPlanned.Items.Count Then
lstPlanned.Items.RemoveAt(i)
End If
Exit Sub
End If
Next
Think that's want you want..maybe ;)
...
System.IO.Directory.CreateDirectory(aMailbox & "\" & AllDetails(n).uName & " - " & AllDetails(n).uCode & " - " & AllDetails(n).uOps)
' After the Dir is created Node is added to the TreeView
tvProgress.Nodes.Remove(rN)
tvProgress.Nodes.Insert(0, rN)
tvProgress.Nodes.Add(New TreeNode(AllDetails(n).uName & " - " & AllDetails(n).uCode & " - " & AllDetails(n).uOps))
For Each f In Directory.GetFiles(zMailbox & AllDetails(n).uFile, "*.dbf")
If File.Exists(f) Then
File.Copy(f, Path.Combine(aMailbox & "\" & AllDetails(n).uName & " - " & AllDetails(n).uCode & " - " & AllDetails(n).uOps, Path.GetFileName(f)), True)
'As ParentNode already exists as Pos 0 you can add child nodes to it
tvProgress.Nodes(0).Nodes.Add(Path.GetFileName(f))
End If
Next
...
I am working on VBA, from which I have to call a vbscript by passing some values.
Here is the code:
''VBA
'Below values are on different cells of Excel file which I am reading
'into a global variable then pass it to vbscript.
'SFilename = VBscript file path
'QClogin = "abc"
'QCpassword = "abc"
'sDomain = "xyz"
'sProject = "xyz123"
'testPathALM = "Subject\xyz - Use it!\xyz_abc"
'QCurl = "http://xxx_yyy_zzz/qcbin/"
Set wshShell = CreateObject("Wscript.Shell")
Set proc = wshShell.exec("wscript " & SFilename & " " & QClogin & _
" " & "" & QCpassword & " " & "" & sDomain & " " & "" & sProject & _
" " & "" & testPathALM & " " & "" & QCurl & "")
''VBscript on some location
Dim strUserName, strPassword, strServer
strUserName = WScript.Arguments(0) '"abc"
Msgbox "strUserName : " & strUserName
strPassword = WScript.Arguments(1) '"abc"
Msgbox "strPassword : " & strPassword
strServer = WScript.Arguments(5) '"http://xxx_yyy_zzz/qcbin/"
Msgbox "strServer : " & strServer
Dim strDomain, strProject, strRootNode
strDomain = WScript.Arguments(2) '"xyz"
Msgbox "strDomain: " & strDomain
strProject = WScript.Arguments(3) '"xyz123"
Msgbox "strProject: " & strProject
strRootNode = WScript.Arguments(4) '"Subject\xyz - Use it!\xyz_abc"
Msgbox "strRootNode: " & strRootNode
Now, when I running the code, it is passing below values properly to vbscript:
QClogin = "abc"
QCpassword = "abc"
sDomain = "xyz"
sProject = "xyz123"
It is having issues with these:
testPathALM = "Subject\xyz - Use it!\xyz_abc"
QCurl = "http://xxx_yyy_zzz/qcbin/"
Now, wierd thing for me is, if I keep a cell empty for "testPathALM" which is having "Subject\xyz - Use it!\xyz_abc" as value, I am getting "QCurl" value properly in vbscript.
But, if I keep value "Subject\xyz - Use it!\xyz_abc" for "testPathALM", then I am getting "-" for strServer which suppose to be "QCurl" value and "Subject\xyz" for "strRootNode" which supposed to be "Subject\xyz - Use it!\xyz_abc".
I am unable to understand what is the issue here.
Thanks a ton in advance.
Safer to quote all of your parameters:
Set wshShell = CreateObject("Wscript.Shell")
Set proc = wshShell.exec("wscript """ & SFilename & """ """ & _
QClogin & """ """ & QCpassword & """ """ & _
sDomain & """ """ & sProject & """ """ & _
testPathALM & """ """ & QCurl & """")
Try a debug.print to make sure it looks as it should...