I have been working on this issue for weeks with no luck. So I thought I would ask for some help. I have a word document that has a term Data Flow Task on it. I am documenting dtsx packages. So in this case I have 35 Data Flow Tasks, which I automatically populate the sheet with the titles Data Flow Task: and Container Name. Since the Data Flow Tasks are the same name I would like to populate them automatically. My current code just populates the last Data Flow Task and that's it. I am getting no errors , but the code isn't doing what I need it to. I started off using the range object but it wouldn't count the next loop. Any help is appreciated.
Public Sub AddDataFlowTaskName()
Dim curDoc As Document
Dim strFindTaskTitle As String
Dim strAddTaskName As String
Dim lTotalCount As Long
Dim lSubTotal As Long
Dim x As Long
Dim y As Long
Dim s1 As Long
Dim e1 As Long
Set curDoc = ActiveDocument
strFindTaskTitle = "Data Flow Task:"
'strAddTaskName = InputBox("Enter Task Name")
'lTotalCount = InputBox("Enter Total Amount of Tasks")
'lSubTotal = InputBox("Enter Amount of Subtasks")
strAddTaskName = "DF STEP 1 Kick"
lTotalCount = 35
lSubTotal = 3
For x = 1 To lTotalCount
For y = 1 To lSubTotal
With curDoc.Range.Find
.Forward = True
.Text = strFindTaskTitle
.Execute FindText:=strFindTaskTitle
curDoc.Content.InsertAfter Text:=strAddTaskName
End With
Next y
Next x
End Sub
Related
I do get a lot of help from this website searching for a solution but at this point I'm completely stuck. I'm not a programmer, still was able to get that far.
The idea of my little project is to download newest version of a program (folder) from FTP server. Unzip files and update current program folder with new files. But before that backup the exiting program folder to a different FTP address.
What I'm struggling with is a way they post program versions (folders) on FTP:
folder structure on FTP
I can't really predict what would be the next folder to download because e.g. for program version:
7.6.16
it might be:
WERSJA_NOWY_TEMPLATE_7.6.17
or
WERSJA_NOWY_TEMPLATE_7.7.01
what ever is being released.
There is an ini file on C drive that holds the current program version. I was able to retrieve that information by reading the line, removing the unnecessary characters and splitting the string:
Dim wersja1 As String = File.ReadAllLines("C:\Windows\file.ini").FirstOrDefault(Function(x) x.Contains("WERSJA="))
Dim characterToRemove1 As String = "WERSJA="
Dim wersja2 As String = Replace(wersja1, characterToRemove1, "")
Dim characterToRemove2 As String = "T"
Dim wersja3 As String = Replace(wersja2, characterToRemove2, "")
Dim wersja4 As String() = wersja3.Split(New Char() {"."c})
Dim w1 As String = wersja4(0)
Dim w2 As String = wersja4(1)
Dim w3 As String = wersja4(2)
e.g. from a line:
WERSJA=7.6.5T
I get:
w1 = 7
w2 = 6
w3 = 5
Then I change the last one (w3) to a two digits number (because of the way folders are named on FTP):
If w3 < 10 Then
w3 = "0" & w3
Else
w3 = w3
End If
So if:
w3 = 5 >> I get 05
w3 = 16 >> I get 16
So far, so good.
In the next step I would like to see a filtered list of program versions (folders) in a ListBox or 2 ListBoxes. I would like to filter the list to see only folder with a bigger number than the current program version, so I can choose the correct one to download.
Why this way? Because if current version is e.g.
7.6.16
and there are 3 new ones e.g.:
7.6.17
7.6.18
7.7.01
I need to download all of them one by one, update program files and start the program to update sql database in order they were released. I can't skip any version on update.
Dim FTPurl As String = "ftp://xx.xx.xxx.xxx/wersje/"
Dim FTPwersja As String = "WERSJA_NOWY_TEMPLATE_*"
Dim FTPlog As String = "xxx"
Dim FTPpass As String = "yyy"
Dim clsRequest As FtpWebRequest = System.Net.WebRequest.Create(FTPurl & FTPwersja)
clsRequest.Credentials = New System.Net.NetworkCredential(FTPlog, FTPpass)
clsRequest.Method = System.Net.WebRequestMethods.Ftp.ListDirectory
Dim listResponse As FtpWebResponse = clsRequest.GetResponse
Dim reader As StreamReader = New StreamReader(listResponse.GetResponseStream())
'folder list
While reader.Peek >= 0
ListBox1.Items.Add(reader.ReadLine)
End While
'remove empty lines
For i As Integer = ListBox1.Items.Count - 1 To 0 Step -1
If ListBox1.GetItemText(ListBox1.Items(i)) = String.Empty Then
ListBox1.Items.RemoveAt(i)
End If
Next i
The above code gives me this result.
I found this code that enables filtering of ListBox but I have no clue on how to convert it to an loop so I would see only folders with bigger numbers than the current version of program:
'filter result in list box
Dim items = From it In ListBox1.Items.Cast(Of Object)()
Where it.ToString().IndexOf("7.5", StringComparison.CurrentCultureIgnoreCase) >= 0
Dim matchingItemList As List(Of Object) = items.ToList()
ListBox1.BeginUpdate()
'ListBox1.Items.Clear() 'add to list
For Each item In matchingItemList
ListBox1.Items.Remove(item) 'remove from list
'ListBox1.Items.Add(item) 'add to list
Next
ListBox1.EndUpdate()
I also have this code to catch choice and prevent crash when clicked on empty line :
Private Sub ListBox1_SelectedIndexChanged(sender As Object, e As EventArgs) _
Handles ListBox1.SelectedIndexChanged
Try
Dim LB1choice = ListBox1.SelectedItem.ToString()
Label5.Text = LB1choice
Catch ex As Exception
ListBox1.SelectedIndex = 0
End Try
End Sub
The ideal would be 2 ComboBoxes where 1st would display e.g.
WERSJA_NOWY_TEMPLATE_7.6
WERSJA_NOWY_TEMPLATE_7.7
and based on the choice 2nd ComboBox would list newer subfolders in it e.g.
WERSJA_NOWY_TEMPLATE_7.6.16
WERSJA_NOWY_TEMPLATE_7.6.17
for the 1st one, and:
WERSJA_NOWY_TEMPLATE_7.7.01
for the 2nd one.
I much appreciate if anyone could help me this because it's beyond my skills.
I have a problem on creating a macro for a certain situation.
I have a STAAD model which has 8 beams and 10 load cases.
I wanted to get the beam end forces for all the beams but only
load cases 1 and 2.
Here's the code
Sub ExtractLC_Click()
Sheets("COPING BEAM").Range("A:I").ClearContents
'Variable Declaration
Dim lMemberNo As Long
Dim lEnd As Long
Dim lLoadCase As Long
Dim dForceArray(6) As Double
Dim icount As Integer
Dim ret As Boolean
Dim path As String
path = Sheets("Main").Cells(185, 23).Value
Set staad = GetObject(, "StaadPro.OpenSTAAD")
staad.OpenSTAADFile path
'extract beam end forces
lMemberNo = Sheets("Main").Cells(184, 10).Value
For x = 2 To 6
lLoadCase = Sheets("SEISMIC").Range("B" & x).Value
ret = staad.Output.GetMemberEndForces(lMemberNo, lEnd, lLoadCase, dForceArray)
For icount = 0 To 5
Sheets("SEISMIC").Cells(x, 3 + icount).Value = dForceArray(icount)
Next icount
Next x
Set staad = Nothing
End Sub
However for the line:
Output.GetMemberEndForces(lMemberNo, lEnd, lLoadCase, dForceArray)
Only the START forces of the beam is extracted not the END.
Excel and STAAD comparison
I wanted both. Is there a certain code that involves opening STAAD,
copying ALL member end forces? Thanks for the help!
Good day!
You can add a loop statement for "lend".
Example:
For lend = 0 to 1
For x = 2 To 6
lLoadCase = Sheets("SEISMIC").Range("B" & x).Value
ret = staad.Output.GetMemberEndForces(lMemberNo, lEnd, lLoadCase, dForceArray)
For icount = 0 To 5
Sheets("SEISMIC").Cells(x, 3 + icount).Value = dForceArray(icount)
Next icount
Next x
next lend
Although you still have to edit the code a bit to paste the results in different cells.
I have a spreadsheet with a column of cells that each contain several paragraphs of text. I'm trying to write a macro that will grab several sentences between these text phrases "How we made our decision" and "Conclusion"
The location of this text string varies from sheet to sheet but the column is always consistent.
I've been able to find a bunch of vba scripts that allow me to find and copy 1 word at a time or simple batches of single word. I'm just not able to figure our or find something that allows me to copy an entire paragraph from within a single cell of paragraphs.
The code below just grabs the entire table. As you can see in the beginning portion I was able to get what I need however I found out that the (70) is irrelevant because the table size changes with each pull of the record.
Sub GetTheData()
Dim T As String
Dim SWs As New SHDocVw.ShellWindows
Dim IE As SHDocVw.InternetExplorer
Dim LetPr As InternetExplorer
Dim Doc As HTMLDocument
'Dim IE As Object
Dim tbls, tbl, trs, tr, tds, td, r, c
For Each IE In SWs
If IE.LocationName = "Letter Preparation Case Summary – Member Case" Then
Set LetPr = IE
'LetPr.document.getElementById
T = IE.document.getElementsByTagName("td")(70).innerText
'T = Trim(Mid(T, InStr(T, "How We Made Our Decision: ") + 0, InStr(T, "Conclusion") - (InStr(T, "How We Made Our Decision:") + 26)))
Exit For
End If
Next
Set tbls = IE.document.getElementsByTagName("table")
For r = 0 To tbls.Length - 1
Debug.Print r, tbls(r).Rows.Length
Next r
Set tbl = IE.document.getElementsByTagName("table")(9)
Set trs = tbl.getElementsByTagName("tr")
For r = 0 To trs.Length - 1
Set tds = trs(r).getElementsByTagName("td")
'if no <td> then look for <th>
If tds.Length = 0 Then Set tds = trs(r).getElementsByTagName("th")
For c = 0 To tds.Length - 1
ActiveSheet.Range("A1").Offset(r, c).Value = tds(c).innerText
Next c
Next r
End Sub
You stated that you wanted the text 'between these text phrases' so the beginning position of the found text will have to be adjusted by hte length of the searched string.
dim beginStr as string, endStr as string, beginPos as long, endPos as long
beginStr = "How We Made Our Decision:"
endStr = "Conclusion"
beginPos = instr(1, T, beginStr, vbtextcompare)
endPos = instr(beginPos, T, endStr, vbtextcompare)
if cbool(beginPos) and cbool(endPos) then
beginPos = beginPos + len(beginStr)
T = Trim(Mid(T, beginPos, endPos - beginPos))
end if
That last endPos - beginPos might have to be adjusted by subtracting 1.
I have an Excel VBA UserForm Combobox for scanning asset tags to compare against a site baseline held in Sheet1. There can be upto 50,000+ assets. The named ranges are all correct.
I want the loop to fill the "Found" Asset attribute Textboxes for Type, Serial, MakeModel, Location & PrinterHost.
The code is below without the additional index match lookups for extra asset attributes as the process will be the same. Help appreciated as I'm not sure where I'm going wrong. Thanks in advance.
Private Sub ComboScanTag_Change()
Dim x As Integer
Dim AssetCount As Long
Dim BASELINE As Range
Dim AssetID As Range
Dim FoundType As Variant
Dim FoundSerial As Variant
Dim FoundMakeModel As Variant
Dim FoundLocation As Variant
Dim FoundPrinterHostName As Variant
If Me.ComboScanTag.Value = "" Then 'ScanTag has no value
MsgBox "Asset not Found - Re-Scan or enter New Asset details"
Me.ComboScanTag.SetFocus
End If
If Me.ComboScanTag.Value <> "" Then 'ScanTag has a value
Application.ScreenUpdating = False 'Turn off screen updating to speed app
For x = 1 To AssetCount 'Number of loop iterations from Baseline Assets Count D1 cell
FoundType = Application.Index("BASELINE", Application.Match(Me.ComboScanTag.Value, "AssetID", False), 3)
If Not IsError(FoundType) = False Then 'if error value in lookup return 0
Me.txtFoundType.Value = FoundType 'Fill textbox FoundType with lookup value from baseline
Else
On Error GoTo 0 'reset error handler
FoundSerial = Application.Index("BASELINE", Application.Match(Me.ComboScanTag.Value, "AssetID", False), 11)
If Not IsError(FoundSerial) = False Then
Me.txtFoundSerial.Value = FoundSerial
End If
Next x
End If
Application.ScreenUpdating = True
End Sub
AssetCount is not initialized. You need to initialize it before you use it like AssetCount = 10.
BASELINE and AssetID are not set as well.
If BASELINE and AssetID are named ranges, you cannot use it the way you do in Application.Index or Application.Match.
You need to pass it as object and not as string like this:
Set BASELINE = ThisWorkbook.Names("BASELINE").RefersToRange
Set AssetID = ThisWorkbook.Names("AssetID").RefersToRange
Then you can use it like this in Application.Index and Match:
With Application
FoundType = .Index(BASELINE, .Match(Me.ComboScanTag.Value, AssetID, False), 3)
End With
I have never read from an excel file in VB.NET before so sorry if anything is off.
I am downloading an .csv file from a vendors ftp service that has 8 columns
( style # - mfr.item # - description - metal type - availability - center weight - total weight - retail value )
I am trying to retrieve all data in the rows bellow style # and retail value
there are roughly 4,649 rows
I am not sure how to do this.
I load the excel file using the microsoft.office.interop.excel:
Dim eApp As excel.Application
Dim eBook As excel.Workbook
Dim eSheet As excel.Worksheet
Dim eCell As excel.Range
eApp = New excel.Application
eBook = eApp.Workbooks.Open(localFile)
eSheet = eBook.Worksheets(1)
eCell = eSheet.UsedRange
Can anyone help me on what I need to do next? I have browsed google for a few hours now and have not gotten anything to work, just return an object name.
Thanks
You are so almost there! Here are two ways.
Way #1: Add the following, after the eCell = eSheet.UsedRange:
Dim eCellArray as System.Array = eCell.Value
Then get the values via eCellArray(r,c), where r is the row and c is the column (each starting from 1).
Way #2: Use this expression to get the value of a cell:
CType(eCell(r,c),Excel.Range).Value ' For Option Strict, or just to get IntelliSense to work.
or simply
eCell(r,c).Value
HTH
You can, for example, access the cells in a range like this:
Dim iRow as Integer = 1
Dim iCol as Integer
Dim rng as Excel.Range = getYourRangeFromSomewhere()
Dim rngCell as Excel.Range
For iCol = 1 To 10
rngCell = rng.Cells(iRow,iCol)
Debug.Print rngCell.Value
Next