VBA Workbooks.open method from Cloud Storage - vba

the code isn't working if i put an URL link, but it does working if it take from my hard disk. any advice? or should I use Microsoft Access?
Sub import_metering_actaris()
Dim directory As String, fileName As String, sheet As Worksheet, total As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
*****directory = "https://app.box.com/files/0/f/11396351585/1/f_95668743837"
fileName = Dir(directory & "CS-FQC MV-001-01 Rev B (ACTARIS).xls")*****
Do While fileName <> ""
Workbooks.Open (directory & fileName)
For Each sheet In Workbooks(fileName).Worksheets
total = Workbooks("qc-generator.xlsm").Worksheets.Count
Workbooks(fileName).Worksheets(sheet.Name).Copy _
after:=Workbooks("qc-generator.xlsm").Worksheets(total)
Next sheet
Workbooks(fileName).Close
fileName = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
it gets error in directory & filename, any help would be appreciated.
thank you

Related

Copy range from sheet, and loop through files in a directory and do the following, Add rows to specific sheet, and paste values into sheet

I need to copy data from one sheet on my desktop, and paste it to every xlsx file in a specified folder. The problem I am encountering is an endless loop of copy paste / adding rows.
paste_value is the value to be pasted in the specified range in the specified sheet " Exhibit 1d"
Below is the code
Sub loopFile()
Dim Filename, Pathname As String
Dim wb As Workbook
Dim paste_value As String
paste_value = Workbooks("copy_file.xlsx").Worksheets("EXHIBIT 1D").Range("B59:C64").Copy
Pathname = "C:\Users\GP8535\Desktop\loop_folder\"
Filename = Dir(Pathname & "\*.xls*")
Do While Filename <> ""
Application.DisplayAlerts = False
Application.ScreenUpdating = False
paste_value = Workbooks("copy_file.xlsx").Worksheets("EXHIBIT 1D").Range("B59:C64").Copy
Set wb = Workbooks.Open(Pathname & Filename)
wb.Worksheets("EXHIBIT 1D").Rows("57:63").EntireRow.Insert
wb.Worksheets("EXHIBIT 1D").Range("B59:C63").PasteSpecial
wb.Close SaveChanges:=True
Loop
End Sub

Try this. A few issues
your syntax for defining paste_value was wrong; I think better to define the range (using Set) and do this outside the loop as it doesn't change
key thing to loop through your files is the last line in the loop; your code would have opened the same workbook each time
don't forget to turn alerts and updating back on at the end
Sub loopFile()
Dim Filename, Pathname As String
Dim wb As Workbook
Dim paste_value As Range
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Pathname = "C:\Users\GP8535\Desktop\loop_folder\"
Filename = Dir(Pathname & "\*.xls*")
Set paste_value = Workbooks("copy_file.xlsx").Worksheets("EXHIBIT 1D").Range("B59:C64")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
wb.Worksheets("EXHIBIT 1D").Rows("57:63").EntireRow.Insert
paste_value.Copy wb.Worksheets("EXHIBIT 1D").Range("B59:C63")
wb.Close SaveChanges:=True
Filename = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Merge multiple Excel files into a new Excel file

I know the question has been asked so many times already, and I have tried to use Google to search the interest but failed to find the correct code. ( Trust me, I am not a taker).
Anyway, the idea is to run a script to merge all Excel files (CAD,GBP,JPY,USD) into a new Excel file (tab shows name "CAD","GBP", "JPY","USD") in the current folder. I have written the following script to merge Excel files, but it does not even work.
Sub CombineWorkbooks()
Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet
Application.EnableEvents = False
Application.ScreenUpdating = False
Path = "X:\PATH\TO\EXCEL\FILES"
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For Each WS In Wkb.Worksheets
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next WS
Wkb.Close False
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

You only have one small mistake.
Change:
Wkb.Close False
To:
Wkb.Close SaveChanges:=False
Here's my full, tested and working solution:
Sub CombineWorkbooks()
Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet
Application.EnableEvents = False
Application.ScreenUpdating = False
Path = "X:\PATH\TO\EXCEL\FILES"
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For Each WS In Wkb.Worksheets
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next WS
Wkb.Close SaveChanges:=False
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
If this doesn't work for you, please give more detail about the results and/or errors. A list of the file names in the folder would also be helpful.
If this does work for you, please remember to mark this as your answer, so others will know you have your solution. Thanks!

Find if workbook for individual user exists, if workbook does not exist, create a new workbook with template

I have a data file that I am trying to make for each person in my work group. The data file needs to be identical to a master file as each persons data will be collected into said master file as well as an individual data file.
So far, I have the following code where I try to identify whether a user already has a workbook. I want the created workbook to have the same first four sheets as the master workbook.
The folder specified only contains the "DataFile Master" Workbook so I wouldn't expect the macro to take longer than ~5 seconds. However, when I try to run the macro, the workbook becomes non responsive.
The program does not induce an error report or indicate something to debug.
Does anyone have any ideas?
Sub StoreToPersonal()
Application.ScreenUpdating = False
ckIndWkbk = False
folderpath = "\\netappa\Path\MACRO UPDATE WORKBOOKS" 'change to suit
If Right(folderpath, 1) <> "\" Then folderpath = folderpath + "\"
filename = Dir(folderpath & "*.xlsm")
'Look through path length and find if user has an individual Workbook with a Boolean Statement
Do While filename <> ""
If InStr(filename, Environ("Username")) Then
ckIndWkbk = True
Else
End If
Loop
If ckIndWkbk = False Then
Set wb = Workbooks.Open("\\netappa\Path\MACRO UPDATE WORKBOOKS\DataFile Master.xlsm")
ws = wb.Sheets.Count
For Each ws In wb
If ws.Index > 4 Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next ws
wb.SaveAs ("\\netappa\Path\MACRO UPDATE WORKBOOKS\\DataFile For " & Environ("Username"))
End If
Application.ScreenUpdating = True
End Sub

The first Dir call sets the parameters and return the first file in the directory. You need to use the Dir in your Do Loop to return subsequent files.
Note: I added Exit Do to after the condition is met.
MSDN Dir Function
Sub StoreToPersonal()
Application.ScreenUpdating = False
ckIndWkbk = False
folderpath = "\\netappa\Path\MACRO UPDATE WORKBOOKS" 'change to suit
If Right(folderpath, 1) <> "\" Then folderpath = folderpath + "\"
Filename = Dir(folderpath & "*.xlsm")
'Look through path length and find if user has an individual Workbook with a Boolean Statement
Do While Filename <> ""
If InStr(Filename, Environ("Username")) Then
ckIndWkbk = True
Exit Do
End If
Filename = Dir
Loop
If ckIndWkbk = False Then
Set wb = Workbooks.Open("\\netappa\Path\MACRO UPDATE WORKBOOKS\DataFile Master.xlsm")
ws = wb.Sheets.Count
For Each ws In wb
If ws.Index > 4 Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next ws
wb.SaveAs ("\\netappa\Path\MACRO UPDATE WORKBOOKS\\DataFile For " & Environ("Username"))
End If
Application.ScreenUpdating = True
End Sub

I keep receiving a compile error in excel with my macro

I keep receiving a compile error in excel with my macro.
I'm trying to make a macro in a shared workbook (I will unshare the workbook to use the macro) and have it copy over to another file (The master file that is unshared and has graphs)
Sub Macro()
Dim directory As String, FILEnAME As String, sheet As Worksheet, total As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
directory = "C:\Users\bucklej\Desktop"
FILEnAME = Dir(directory & "Copy of AMS Engineering Transitions Database")
Do While FILEnAME <> ""
Loop
Workbooks.Open (directory & FILEnAME)
For Each sheet In Workbooks(FILEnAME).Worksheets
total = Workbooks("Copy of AMS Engineering Transitions Database.xls").Worksheets.Count
Workbooks(FILEnAME).Worksheets(sheet.Name).Copy_
after: Workbooks("Copy of AMS Engineering Transitions Database.xls").Worksheets (total)
Next sheet
Workbooks(FILEnAME).Close
FILEnAME = Dir()
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Recently updated code still getting a compile error
Sub Macro()
Dim directory As String, FILEnAME As String, sht As Worksht, total As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
directory = "C:\Users\bucklej\Desktop\"
FILEnAME = Dir(directory & "Copy of AMS Engineering Transitions Database.xls")
Do While FILEnAME <> ""
Loop
Workbooks.Open (directory & FILEnAME)
For Each sht In Workbooks(FILEnAME).Workshts
total = Workbooks("Copy of AMS Engineering Transitions Database.xls").Workshts.Count
Workbooks(FILEnAME).Workshts(sht.Name).Copy_
after: Workbooks("Copy of AMS Engineering Transitions Database.xls").Worksht (total)
Next sht
Workbooks(FILEnAME).Close
FILEnAME = Dir()
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

This compiles.
Note that the named arguments like After in the Copy method must be stated like After:=..., you had forgotten the =.
I also note in your revised code that you have changed .Worksheets to .Workshts. I am not sure why you did this, but there is no such member as a Worksht so that will also raise an error.
You need to make sure that your FILENAME variable has a file extension. Yours did not.
FYI from the Debug menu you can test compile the project at any time, and it should help identify what the source of the error is.
Sub Macro()
Dim directory As String, FILENAME As String, sht As Worksheet, total As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
directory = "C:\Users\bucklej\Desktop\"
FILENAME = Dir(directory & "Copy of AMS Engineering Transitions Database.xls")
Do While FILENAME <> ""
Loop
Workbooks.Open (directory & FILENAME)
For Each sht In Workbooks(FILENAME).Worksheets
total = Workbooks("Copy of AMS Engineering Transitions Database.xls").Worksheets.Count
Workbooks(FILENAME).Worksheets(sht.Name).Copy after:=Workbooks("Copy of AMS Engineering Transitions Database.xls").Worksheets(total)
Next sht
Workbooks(FILENAME).Close
FILENAME = Dir()
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Note that this loop does nothing:
Do While FILENAME <> ""
Loop

bringing just one worksheet

Here is a code I have to bring in worksheets from another workbook.
But what I need is to only bring one worksheet (not all of them).
I also need macro to rename the worksheet to something other than what it's called in the original workbook that it's imported from. Can anyone help me with those two tweeks?
Here is what I have:
Option Explicit
Private Sub Bring_Workbooks_Click()
Dim directory As String, fileName As String, sheet As Worksheet, total As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
directory = "access path to where the original workbook is stored"
fileName = Dir(directory & "Name of workboork where sheet will be copied from.xls")
Do While fileName <> ""
Workbooks.Open (directory & fileName)
For Each sheet In Workbooks(fileName).Worksheets
total = Workbooks("Name of my workbook.xlsm").Worksheets.Count
Workbooks(fileName).Worksheets(sheet.Name).Copy _
after:=Workbooks("Name of my workbook.xlsm").Worksheets(1)
Next sheet
Workbooks(fileName).Close
fileName = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Try this code:
Sub Bring_Workbooks_Click()
Dim path, fileName, WkshtOrig, fullName, MyWkbk As String
Dim total As Integer
path = "C:\VBA\" 'access path to where the original workbook is stored
fileName = "OrigWkbk.xlsx" 'Name of workbook where sheet will be copied from.xls
fullName = path & fileName
WkshtOrig = "My Orig Wksht" 'name of worksheet to be copied & placed in this workbook.
MyWkbk = "StkOvrFlwuser3738555.xlsm" 'What I named my sample workbook
Workbooks.Open fileName:= fullName
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Workbooks(fileName).Worksheets(WkshtOrig).Copy _
after:=Workbooks(MyWkbk).Worksheets(1)
Workbooks(MyWkbk).Worksheets(WkshtOrig).Select
ActiveSheet.Name = "MyNewName"
Workbooks(fileName).Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub