I was wondering that I can get some help with this code,
I am trying to download files from a website, the code I am using is
Public Sub DownloadFile()
Dim weblink As String
weblink = "https://documentflowmanagerus.abcabc.com/DFM_HBTC/Default.aspx?page=RetrDocView.aspx&URN="
Set Rng = Range("A1:A100")
For Each cell In Rng
'test if cell is empty
If cell.Value <> "" Then
link = weblink & cell.Value
ActiveWorkbook.FollowHyperlink Address:=link, NewWindow:=False
End If
Next
End Sub
this code is working alright, on the column A there is a list of all URN numbers where it loops,
this code loops through column A and goes to hyperlink to download file
the trouble is I have to save all the files manually , since each time it loops it opens a new tab in the browser
I am looking for a way that it closes the tab automatically and download file without manually saving it
Related
its just that i have come up with some code, which does the copy paste webpage into text format in my excel sheet.
few modification were required.
Addition modification requires to make a loop through code so that it access the input from Excel(in attachment-Input sheet) and make changes to URL(i noticed in URL that only last word needs to be changed which will be taken from excel file column 1and so on till its find blank).
As, its looping correctly but there is no loop for data pasting henece its dumping all the looped data to one cell.
My basic requirment of this macro is to access link from column A, and paste its data to column B.
Sub Trial()
Dim IE As Object
Dim URL As Range
For Each URL In Range("A1:A3").Cells
Set IE = CreateObject("InternetExplorer.Application")
With IE
.Visible = True
.navigate "1ox11is" & URL
Do Until .readyState = 4: DoEvents: Loop
'Range("B1").Value = .document.body.innerText
'wsSheet.Range("B" & Rows).Value = .document.body.innerText
Sheets("Sheet1").Range("B1").Value = .document.body.innerText
.Quit
End With
Next
End Sub
Assuming that links are in cells A1,A2,A3 etc. and data from websites is supposed to appear next to them in cells B1,B2,B3 etc, change:
Sheets("Sheet1").Range("B1").Value = .document.body.innerText
to:
Sheets("Sheet1").Range("B" & URL.Row).Value = .document.body.innerText
I made the code to convert the values to the csv file but the problem is
that I'm not sure if this is the right way because this is the first time I even touched VBA macro! As seen in the image I provided, there is a button "Convert to CSV", when I tap it, the macro will call ExportWorksheetAndSaveAsCSV method and will convert the entire sheets contents into csv. However, it looks like it converts the entire sheet it'self.
What I want to do is the following steps .
1.Pass in the Sheet name as a parameter like ExportWorksheetAndSaveAsCSV("Sheet2"), so that it can be used as a file name. But I'm not sure how I can pass a parameter in function from the Buttton.
2.Convert the values in the columns E to I to CSV. If possible want to have the tites of the data show in the first row of the csv file.
I attached the image and the code so you can see. Some tips or examples will be really helpful! I would love to hear from you.
Public Sub ExportWorksheetAndSaveAsCSV()
Dim wbkExport As Workbook
Dim shtToExport As Worksheet
Dim book As String
Dim fileName As String
book = "Sheet1"
fileName = "test.csv"
Set shtToExport = ThisWorkbook.Worksheets(book) 'Export to CSV file
Set wbkExport = Application.Workbooks.Add
shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
Application.DisplayAlerts = False
wbkExport.SaveAs fileName:="C:\Users\myStuff\Documents\" & fileName, FileFormat:=xlCSV
Application.DisplayAlerts = True
wbkExport.Close SaveChanges:=False
End Sub
What is the best way to store a large text file (max 10Mb) in an Excel file?
I have a couple of requirements:
It has to be embedded so that the excel file can be moved and sent to a different computer and all the text files will follow.
It needs to be done from a macro.
And a macro needs to be able to read the file contents after it has been embedded.
I already tried to store it by breaking the text into several chunks enough small to fit into a cell (~32 000 chars), but it didn't work. After my macro had inserted the first 150 000 characters it gave me an "Out of Memory" error.
I remember seeing one web page with a couple of options for this I but cannot find it anymore. Any suggestions are most welcome. I will try them out if you are not sure if it works or not.
It would likely be best to simply save the .txt file alongside the Excel file, and have the macro pull the text as needed from that folder. To read more on importing files see this:
http://answers.microsoft.com/en-us/office/forum/office_2010-customize/vba-code-to-import-multiple-text-files-from/525bd388-0f7d-4b4a-89f9-310c67227458
Keeping the .txt within the Excel file itself is not necessary and will likely make it harder to transfer files in the long run. For example, if you cannot e-mail a file larger than 10MB, then you can simply break your .txt file in half and e-mail separately - using a macro which loads the text into Excel locally.
Very simple CustomXMLPart example:
Sub CustomTextTester()
Dim cxp1 As CustomXMLPart, cxp2 As CustomXMLPart
Dim txt As String
'read file content
txt = CreateObject("scripting.filesystemobject").opentextfile( _
"C:\_Stuff\test.txt").readall()
'Add a custom XML part with that content
Set cxp1 = ThisWorkbook.CustomXMLParts.Add("<myXMLPart><content><![CDATA[" & txt _
& "]]></content></myXMLPart>")
Debug.Print cxp1.SelectSingleNode("myXMLPart/content").FirstChild.NodeValue
End Sub
Consider the method shown below. It uses Caption property of Label object located on a worksheet for data storage. So you can create a number of such containers with different names.
Sub Test()
Dim sText
' create special hidden sheet for data storage
If Not IsSheetExists("storage") Then
With ThisWorkbook.Worksheets.Add()
.Name = "storage"
.Visible = xlVeryHidden
End With
End If
' create new OLE object TypeForms.Label type as container
AddContainer "test_container_"
' read text from file
sText = ReadTextFile("C:\Users\DELL\Desktop\tmp\tmp.txt", 0)
' put text into container
PutContent "test_container_", sText
' retrieve text from container
sText = GetContent("test_container_")
' show length
MsgBox Len(sText)
' remove container
RemoveContainer "test_container_"
End Sub
Function IsSheetExists(sSheetName)
Dim oSheet
For Each oSheet In ThisWorkbook.Sheets
If oSheet.Name = sSheetName Then
IsSheetExists = True
Exit Function
End If
Next
IsSheetExists = False
End Function
Sub AddContainer(sName)
With ThisWorkbook.Sheets("storage").OLEObjects.Add(ClassType:="Forms.Label.1")
.Visible = False
.Name = sName
End With
End Sub
Sub RemoveContainer(sName)
ThisWorkbook.Sheets("storage").OLEObjects.Item(sName).Delete
End Sub
Sub PutContent(sName, sContent)
ThisWorkbook.Sheets("storage").OLEObjects.Item(sName).Object.Caption = sContent
End Sub
Function GetContent(sName)
GetContent = ThisWorkbook.Sheets("storage").OLEObjects.Item(sName).Object.Caption
End Function
Function ReadTextFile(sPath, iFormat)
With CreateObject("Scripting.FileSystemObject").OpenTextFile(sPath, 1, False, iFormat)
ReadTextFile = ""
If Not .AtEndOfStream Then ReadTextFile = .ReadAll
.Close
End With
End Function
I am particularly new to coding, not to mention VBA. After a week of really cracking down on learning VBA, I've started to get the hang of it. At the moment, I'm trying to put together a code that will pull the hyperlinks (both addresses and names) out of a word document (eventually word, excel, and power point files), and dump them into the excel file I run the code from. It also dumps the file path and name at the top of the list. I can run the code and pull links from 1 file at a time, and the code pops it out after the end of the last filled line. It will save me endless amounts of time when I have to update links.
Sub ExtractWordLinks()
'the following code gets and sets an open file command bar for word documents
Dim Filter, Caption, SelectedFile As String
Dim Finalrow As String
Filter = "docx Files (*.docx),*.docx, doc Files (*.doc),*.doc, xlsm Files (*.xlsx),*.xlsx"
Caption = "Please Select .doc, .docx, .xlsx files only, " & TheUser
SelectedFile = Application.GetOpenFilename(Filter, , Caption)
'check if value is blank if it is exit
Finalrow = Cells(Rows.Count, 1).End(xlUp).Row
If (Trim(SelectedFile) = "") Then
Exit Sub
Else
'setting up the inital word application object
Set wordapp = CreateObject("word.Application")
'opening the document that is defined in the open file dialog
wordapp.documents.Open (SelectedFile)
'ability to change wether it needs to burn cycles updating the UI
wordapp.Visible = False
'declare excel sheet
Dim xlsSheet As Excel.Worksheet
'set active sheet
Set xlsSheet = Application.ActiveSheet
Dim i As Integer
i = 1
'MsgBox (wordapp.ActiveDocument.Hyperlinks.Count)
For i = 1 To wordapp.ActiveDocument.Hyperlinks.Count
'puts the title of the document in the formatted cells
'xlsSheet.Cells(Finalrow + 1, 1).Value = wordapp.ActiveDocument.Path & "\" & wordapp.ActiveDocument.Name
'formats the file name cell to be a bit easier to discern from the listing.
Range(Cells(Finalrow + 1, 1), Cells(Finalrow + 1, 2)).Font.Bold = True
Range(Cells(Finalrow + 1, 1), Cells(Finalrow + 1, 2)).Merge
'save the links address.
xlsSheet.Cells(Finalrow + i, 1).Value = wordapp.ActiveDocument.Hyperlinks(i).Address
'save the links display text
xlsSheet.Cells(Finalrow + i, 2).Value = wordapp.ActiveDocument.Hyperlinks(i).TextToDisplay
Next
wordapp.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
wordapp.Quit SaveChanges:=wdDoNotSaveChanges
End If
End Sub
My problem, is that when I run this code on a simple sample file with 3 or so hyperlinks in it across a single page, it returns everything exactly how I want, with the file path/name at the top and all the links in the page directly below it (address in one column, displayed text in the other). However, when I run it on one of the files I am writing this code for (a 95+ page .docx file with ~30 links), it prints out the path/file in the formatted section, and then drops 90 (90 every time) blank lines before printing out the path/file a second time, and then all the links in the document. It does it perfectly, except for the inexplicable second path/file (even there if I comment out the bit I put in) and the 90 blank entries.
Can anyone explain what's going on, or should I try to figure out a way to just bypass the issue by removing my own link code, and including a bit that removes all blank lines?
My question is as follows:
I have given a workbook to multiple people. They have this workbook in a folder of their choice. The workbook name is the same for all people, but folder locations vary.
Let's assume the common file name is MyData-1.xls.
Now I have updated the workbook and want to give it to these people. However when they receive the new one (let's call it MyData-2.xls) I want specific parts of their data pulled from their file (MyData-1) and automatically put into the new one provided (MyData-2).
The columns and cells to be copied/imported are identical for both workbooks. Let's assume I want to import cell data (values only) from MyData-1.xls, Sheet 1, cells B8 through C25 ... to ... the same location in the MyData-2.xls workbook. How can I specify in code (possibly attached to a macro driven import data now button) that I want this data brought into this new workbook. I have tried it at my own location by opening the two workbooks and using the copy/paste-special with links process. It works really well, but It seems to create a hard link between the two physical workbooks. I changed the name of the source workbook and it still worked. This makes me believe that there is a "hard link" between the tow and that this will not allow me to give the target (MyData-2.xls) workbook to others and have it find their source workbook.
To clarify my understanding, each user has a spreadsheet called MyData-1.xls but with varying locations. You would like to send each person a new spreadsheet MyData-2 which will automatically pull in data from range B8:C25 in MyData-1.xls?
There are various options on doing this and below I have provided one way of doing this. In short, the user will open MyData-2, click a button, and the code will search for MyData-1 on their directory, open the workbook, grab the data, paste it into MyData-2, and then close MyData-1.
Sub UpdateWorkbook()
'Identify workbook you would like to pull data from (same for all users)
Dim TargetWorkbook As String
TargetWorkbook = "MyData-1"
'Get the full path of that workbook by searching in a specified directory
Dim TargetPathName As String
TargetPathName = GetFilePath(TargetWorkbook)
'Retrieve data in range B8:C25, copy and paste, then close workbook
Dim TargetRng As Range
Application.ScreenUpdating = False
Workbooks.Open Filename:=TargetPathName
Set TargetRng = Sheets("Sheet1").Range("B8:C25")
TargetRng.Copy Destination:=ThisWorkbook.Worksheets(1).Range("B8:C25")
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub
Function GetFilePath(TargetWkbook As String) As String
Dim FullFilePath As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = "C:\"
.FileType = msoFileTypeExcelWorkbooks
.SearchSubFolders = True
.Filename = TargetWkbook
If .Execute > 0 Then
FullFilePath = .FoundFiles(1)
End If
End With
GetFilePath = FullFilePath
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Function
By way of explanation:
In the sub you first need to specify the name of the workbook MyData-1
The Function GetFilePath will then get the full path name of the workbbok. Note that I have set it to look in the "C:\" drive and you may want to amend that
Once we have the full file path we can easily open the workbook and copy the required range.
Note that the screenupdating is turned off to create the 'illusion' that the workbook has not been opened when the data is copied. Also, I have added a button on the worksheet of MyData-2 to trigger the code i.e. user opens workbook, presses button, and data is imported.
Finally, this code could be augmented significantly and you may want to tweak it. For example, error checking if file not found, searching in multiple directories (e.g C:\, D:)...
Hope this gets you started on the right track
You should use the copy/paste-special for values only:
Private Sub ImportData_Click()
On Error GoTo OpenTheSheet
Workbooks("MyData-1.xls").Activate
GoTo SheetOpen
OpenTheSheet:
Workbooks.Open "MyData-1.xls"
Workbooks("MyData-1.xls").Activate
SheetOpen:
On Error GoTo 0
Workbooks("MyData-1.xls").Worksheets("sheetwhatever").firstRange.Copy
Workbooks("MyData-2.xls").Worksheets("anothersheet").yourRange.PasteSpecial(xlPasteValues)
End Sub
This could be cleaned up a bit, but it's always messy to do file stuff in VBA, I'd probably put the opening code in a function.
Make sure they put the new file in the same directory as the old file.