VB to access and input file

cmccabe

Active Member
Joined
Feb 20, 2008
Messages
396
I also have this post here: but have not heard anything.

access website and input file

I use the below VB (thank you Charles and the others
to parse an input file and save it to a new text file (Sanger.txt)

There are 4 Subs in the code and the last is what is suppossed to access the site and submit the data.

I am trying to have that file be sent to a website (Sub Login_OutputFile() and have results emailed. I have attached the input (Sanger.txt)for the website as well as the output (Results.txt). I use chrome to access the website. Thank you very much
.

VB
Code:
[COLOR=#333333]Sub OutPut_1()[/COLOR]

<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit;">Application.ScreenUpdating = FalseDim c As VariantDim Alrow As LongDim Blrow As LongDim SearchString As StringDim rngFind As Range, firstAddress As StringConst FindChar As String = ">"With Sheets("Sheet1").Range("B2:B" & Range("B65536").End(xlUp).Row)''''''' Find " > " in column B and copy row to sheet 2 '''    Set c = .Find(What:=FindChar, Lookat:=xlPart)    If Not c Is Nothing Then        firstAddress = c.Row        '''' firt charcter found copy to sheet2 ''        Blrow = Sheets("Sheet2").Range("A65536").End(xlUp).Row + 1        Range("A" & c.Row & ":F" & c.Row).Copy Destination:=Sheets("Sheet2").Range("A" & Blrow)        Do            Set c = .FindNext(c)            Blrow = Sheets("Sheet2").Range("A65536").End(xlUp).Row + 1            Range("A" & c.Row & ":F" & c.Row).Copy Destination:=Sheets("Sheet2").Range("A" & Blrow)        Loop While Not c Is Nothing And c.Row <> firstAddress    End If    Call ParseMedicalCodesEnd WithEnd SubSub Write2Text()    Const ForAppending = 2    Dim lrow As Long    Dim MyFile As String    Dim fnum    Dim strTemp As String    Dim X      As Long    Sheets("Sheet2").Select    For X = 2 To Range("g" & Rows.Count).End(xlUp).Row        strTemp = strTemp & Range("g" & X) & vbCrLf    Next X    MyFile = "C:\Users\cmccabe\Desktop\Sanger\Sanger.txt"    'your output filename here    fnum = FreeFile()    Open MyFile For Append As fnum    Print #fnum, strTemp    Close fnum    '''' Clear data in sheet 2 '''    lrow = Sheets("Sheet2").Range("A65536").End(xlUp).Row    '''' clear the data ''    Sheets("Sheet2").Range("A2:G" & lrow).ClearContents    Sheets("Sheet1").Activate    ThisWorkbook.SaveEnd SubSub ParseMedicalCodes()  Dim LastRow As Long  Sheets("Sheet2").Activate  LastRow = Cells(Rows.Count, "B").End(xlUp).Row  With Range("G2:G" & LastRow)    .Value = Evaluate(Replace("IF(LEN(B2:B#),F2:F#&"":""&B2:B#,"""")", "#", LastRow))    .Replace ";*", "", xlPart    .Replace ">*/", ">", xlPart  End With  Call Write2TextEnd SubSub Login_OutputFile()    Dim IE As Object, strURL As String    Set IE = CreateObject("InternetExplorer.Application")    strURL = "https://mutalyzer.nl/batchPositionConverter"    IE.Navigate strURL     'Wait until page is loaded.    While IE.ReadyState < 4 ' READYSTATE_COMPLETE = 4        DoEvents    Wend    IE.Visible = True         IE.Document.all("batchEmail").Value = "cmccabe1@luriechildrens.org"    IE.Document.all("arg1").Value = "hg19"    IE.Document.all("batchFile").Click    IE.Document.Forms(0).submit     'Wait until page is loaded.    While IE.ReadyState < 4 ' READYSTATE_COMPLETE = 4        DoEvents    Wend </code>[COLOR=#333333]End Sub[/COLOR]


I have put the files on box.net:
https://app.box.com/s/25edqct1wl33bqjoo0ig

Sanger.txt = input file
Results = end result

Thank you :).

 
Last edited:

Some videos you may like

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

cmccabe

Active Member
Joined
Feb 20, 2008
Messages
396
Is the,
Code:
 [COLOR=#333333] MyFile = "C:\Users\cmccabe\Desktop\Sanger\Sanger.txt"    'your output filename here [/COLOR]

being submitted?

the line of code is part of the Sub Write2Text.
 

Watch MrExcel Video

Forum statistics

Threads
1,108,624
Messages
5,523,968
Members
409,547
Latest member
AW2020

This Week's Hot Topics

Top