I am writing a macro that opens 2 workbooks and does some manipulation in one and copies it over to another and then it saves it as a .csv file. The first workbook is opened by defined string variables using the workbooks.open function and the other workbook is opened by the filepath and the filename being values set by the cell values in the worksheet. The goal is to go down the column where the names are stored and open those workbooks, do the manipulation, save as a .csv file, close and then go to the next name in the column list.
dim fpath, fname, path, wname, tempname, fpath2 as string
dim mainwkbk, trgwkbk, srcwkbk as workbook
dim main_ws as worksheet
dim main_lr, name_col as integer
dim q as long
set mainwkbk = workbooks("title1.xlsx")
set main_ws = mainwkbk.worksheets(1)
main_ws.activate
main_lr = main_ws.cells(rows.count,10).end(xlup).row
fpath = Range("I2")
for q = 2 to main_lr
tempname = "_template_name.csv")
fpath2 = "C:\temp\locaiton\"
workbooks.open(fpath2 & tempname)
set trgwkbk = workbooks(tempname)
fname = main_ws.cells(q,10).value
path = fpath & fname & ".xlsx"
workbooks.open(path)
set srcwkbk = workbooks(fname & ".xlsx")
2nd_macro (fname)
next q
The 2nd macro does the manipulation, which essentially copes over columns from the .xlsx file to the .csv file and it also runs a 3rd macro. The 2nd and 3rd macros work essentially, because they've been tested independent of the master macro. The macro stops after it opens the 1st workbook. I've looked at other macros I"ve written and I don't recall them stopping after running. I don't have those files anymore so I can't test those macros.
so I started from scratch and this is the code I used. it's no different than the first comment.
dpath = Range("I2")
fname = Range("J2")
set srcwkbk = workbooks.open(dpath & fname)
tempname = "name.csv"
fpath = "C:\path\"
set trgwkbk = workbooks.open(fpath & tempname)
srcwkbk.activate
call ind_level_calc
transfer_macro (fname)
Related
I'm using a PowePoint Macro-enabled client (.PPTM) to gather survey data. When a user completes the survey, I'd like the .PPTM file to write the survey-complete date to an Excel file (via an Excel .App object).
The .PPTM and .XLSX files are both in the same SharePoint folder (access permissions are all correct). The .PPTM client can access the .XLSX file and load data, but attempts to write data back have no effect. The .XLSX file is merely a blank file with only 1 worksheet.
Have used both Excel .app objects and Excel worksheet objects to try to write data via '[object].Value = variable' syntax. Have tried both .Range and .Cell methds, but no luck with either one. The statements execute without error, but no data shows up in the target (addressed) cell.
I'm attaching a demo code block with all key aspects of this task. Is there something that's missing here? or is there some idio-syncratic limit that keeps an Excel .App object from writing data to an Excel file? All comments and feedback greatly appreciated.
Sub TEST()
Debug.Print Chr(10) & "|--TEST--|" & Chr(10)
Dim filePath As String, fileName As String
Dim fileTabName As String
Dim DataFile As Excel.Application ' process support var
Dim DataFile_Tab As Worksheet ' process support var
Dim results_Row As Integer, results_Col As Integer
Dim date_Stamp As String
'---------------------------------------------
' Assign FilePath, FileName, FileTabName
filePath = "https://[ SharePoint folder path here ]/"
fileName = "Test_Target.xlsx?web=1"
fileTabName = "Target"
'---------------------------------------------
' Establish connection to Excel Data File
Set DataFile = New Excel.Application
DataFile.Workbooks.Open _
filePath & fileName, _
True, _
True ' filePath & fileName & fileTabName, _
Set DataFile_Tab = DataFile.Worksheets(fileTabName)
date_Stamp = Format(Now(), "dd/mm/yyyy")
results_Row = 2
results_Col = 2
Debug.Print "DataFile_Tab.Cells(" & results_Row & ", " & results_Col & ").Value = '" & _
date_Stamp & "'"
DataFile_Tab.Cells(results_Row, results_Col) = date_Stamp
DataFile_Tab.Cells(results_Row, results_Col).Value = date_Stamp
'---------------------------------------------
' Terminate connection to Excel Data File
Set DataFile = Nothing
Set DataFile_Tab = Nothing
End Sub
You're opening the workbook in read-only mode (3rd parameter of Workbooks.Open), and never saving it. Try the following (untested).
Dim app As Excel.Application
Set app = New Excel.Application
Dim dataFile As Excel.Workbook
Set dataFile = app.Workbooks.Open(filePath & fileName, True)
Dim tabName As String
tabName = "Target"
Dim resultsRow As Long, resultsCol As Long
resultsRow = 2
resultsCol = 2
dataFile.Worksheets(tabName).Cells(resultsRow, resultsCol).Value = Date
dataFile.Save
dataFile.Close
app.Quit
I am writing a reporting system where the user fills out a form and a form button runs a macro to save the file with a name based on several fields including a timestamp.
All the data is is also on a second sheet but in one row for ease of copying to a master sheet.
I am trying to to extend the save macro to copy this row to the last line of a second workbook.
This was successful when the macro was run from a separate workbook but I can't for the life of me work out how to do it from within the file itself.
I've triple checked the paths themselves, I know they're right as the new files are being created, I've run msgbox in the code to check the filename and the variable are the same too.
timestampedfile = Worksheets("single_line").Range("b3")
totalpath = Path & timestampedfile & ".xlsm"
ActiveWorkbook.SaveCopyAs filename:=totalpath
master_wb = "s:\blah\blah\blah.xlsx"
master_sht = "Master_Database"
contact_wb = totalpath
contact_sht = "single_line"
Workbooks.Open (master_wb)
Workbooks.Open (contact_wb)
MsgBox (totalpath)
Workbooks(contact_wb).Worksheets(contact_sht).Range("A3:AQ3").Copy Worksheets(master_wb).Sheets(master_sht).Range("A" & Rows.Count).End(xlUp)(2)
'
Both the Workbooks open so I know the paths are right, can anyone help?
Solution by OP
Solved thanks to comment about workbook variables by BigBen:
Use workbook variables, instead of referencing the workbook by name: Dim masterWb as Workbook, then Set masterWb = Workbooks.Open("s:\blah\blah\blah.xlsx" ). Similarly for the contact workbook. You might consider using worksheet variables too, instead of using sheet names.
Code changed to:
Dim master_wb As Workbook
Dim contact_wb As Workbook
Dim master_sht As Worksheet
Dim contact_sht As Worksheet
Path = "S:\blah\" & Worksheets("report").Range("c8") & "\"
filename = Worksheets("back_end_formulas").Range("e10")
timestampedfile = Worksheets("single_line").Range("b3")
totalpath = Path & timestampedfile & ".xlsm"
ActiveWorkbook.SaveCopyAs filename:=totalpath
SetAttr totalpath, vbReadOnly
Set master_wb = Workbooks.Open("S:\blah\Master_Database2.xlsx")
Set master_sht = master_wb.Sheets("Master_Database")
Set contact_wb = Workbooks.Open(totalpath)
Set contact_sht = contact_wb.Sheets("single_line")
ThisWorkbook.Activate
contact_sht.Range("A3:AQ3").Copy master_sht.Range("A" & Rows.Count).End(xlUp)(2)
master_wb.Close SaveChanges:=True
contact_wb.Close SaveChanges:=False
ActiveWorkbook.Close SaveChanges:=False
Below is working code that is looping through files in a folder based on a user's search criteria. The folder will grow throughout the year to over 1000 files, so rather than looping through all of them every time the macro runs, I would like to add a second criteria that compares the time stamps on the files to a time stamp saved on the file as the last time it was run. LastUpdateDate is set up as variable in date format at the top of the module, and the old timestamp is saved to it at the beginning of the code.
I tried this but it left me with a run time error. Is this doable using Do While, or is there another format I need to be looking at? I also tried nesting the date comparison as an if statement under the Do While, but came up with other errors.
Do While FileName <> "" and FileDateTime(FileName) > LastUpdateDate
Working code from this section:
FileName = Dir(FolderName & "*" & MyCriterion & "*" & ".xl??")
'Loop through all matching files
Do While FileName <> ""
'Open the next matching workbook
Workbooks.Open (FolderName & FileName)
Sheets("Report Data").Select
'Call GrabTheData
GrabTheData
'Close the workbook
Workbooks(FileName).Close savechanges:=False
'Get the name of the next match in folder
FileName = Dir
Loop
End Sub
Two things:
FileDateTime
FileDateTime requires the full file path, not just the file name
Loops and Conditions
Do While (condition) stops execution of the block when (condition) is no longer true.
That is, it will stop execution as soon as (condition) is false. I don't believe this is the intended behavior.
Put an If (condition) block within the loop itself. This will loop through every workbook that matches MyCriterion, but only operate on those that match (condition).
Example (with recommendations)
Sub GrabAllData(ByVal FolderName As String, ByVal MyCriterion As String)
Dim FileName As String
Dim LastUpdateDate As Date
Dim wb As Workbook
LastUpdateDate = ThisWorkbook.Worksheets("Parameters").Range("LastUpdateDate").Value 'Named Range called LastUpdateDate on sheet "Parameters" in ThisWorkbook
'Make sure FolderName ends in a backslash
If Right(FolderName, 1) <> "\" Then FolderName = FolderName & "\"
'Get matching files for MyCriterion
FileName = Dir(FolderName & "*" & MyCriterion & "*" & ".xl??")
'Loop through all matching files
Do While FileName <> ""
If FileDateTime(FolderName & FileName) > LastUpdateDate Then 'FileDateTime requires the full file path, not just the file name
'Open the next matching workbook - work with the workbook directly, rather than working with ActiveWorkbook, ActiveSheet and Selections
Set wb = Workbooks.Open(FileName:=FolderName & FileName, ReadOnly:=True)
'Call GrabTheData on the workbook
GrabTheData wb
'Close the workbook
wb.Close SaveChanges:=False
End If
'Get the name of the next match in folder
FileName = Dir
Loop
Set wb = Nothing
End Sub
Sub GrabTheData(ByRef wb As Workbook)
Dim wsOut As Worksheet, wsIn As Worksheet
Set wsOut = ThisWorkbook.Worksheets("Aggregated Data") 'Worksheet called "Aggregated Data" in ThisWorkbook
Set wsIn = wb.Worksheets("Report Data")
' ### Manipulate the data and write to wsOut, no need to work with Selections ###
End Sub
I am trying to create a macro that will search a folder for a .dat file that contains "OPS"(not case sensitive) in the name, if it finds a file I would like to open it and run another macro, save the file as the original filename.xlsm, and close.
So far, I am able to search for the name but that's about the extent of my knowledge.
Sub Test2()
Dim sh As Worksheet, lr As Long, fPath As String, fName As String, rFile() As Variant
fPath = "C:\Users\ntunstall\Desktop\test\"
ctr = 1
fName = dir(fPath & "*.dat")
Do Until fName = ""
If InStr(fName, "OPS") > 0 Then
ReDim Preserve rFile(1 To ctr)
rFile(ctr) = fName
ctr = ctr + 1
End If
fName = dir
Loop
For i = LBound(rFile) To UBound(rFile)
'The variable rFile(i) represents the workbooks you want to work with.
MsgBox rFile(i)
Next
End Sub
Ideally, this macro would run any time a .dat file containing OPS in the filename is opened. Any help is appreciated, thanks.
To the top add
Dim wb as workbook
and then replace your message box line with
Set wb = Workbooks.Open(fPath & rFile(i))
wb.SaveAs fPath & Split(rFile(i), ".")(0), xlOpenXMLWorkbookMacroEnabled
wb.Close
I tested with a tab deliminated file and it worked well. Your issues may vary if you have a different format.
I have written a code that opens a password protected workbook in a folder, copy some values out of it and paste the values in active woorkbook. This works fine.
My problem is that I have 16 password protected files in this folder, and I need a loop that does the same thing with every file. Below you can find the code, and I think all my problems should be properly explained with comments inside the code. Please ask if anything is unclear. In advance, thanks for any help!
Code:
Sub Bengt()
Dim sPath As String
Dim vFolder As Variant
Dim sFile As String
Dim sDataRange As String
Dim mydata As String
Dim wb As Workbook
Dim WBookOther As Workbook
Dim myArray As Variant '<<does the list of passwords have to be array?
sPath = ThisWorkbook.Path & Application.PathSeparator
sDataRange = "Budsjett_resultat'!E2" '<<every file I want to open has data in this sheet and range
sFile = "BENGT.xlsm" '<< how to make sFile be every file in folder?
' here I want a loop that opens every woorkbook in the folder M::\SALG\2016\Budsjett\
Set WBookOther = Workbooks.Open(sPath & sFile, Password:="bengt123")
' all passwords starts with filename + three numbers after as you can see
' here I want to make excel find the password out of a list of passwords in range B100:B116
mydata = "='" & sPath & "[" & sFile & "]" & sDataRange
'mydata = "='M:\SALG\2016\Budsjett\Bengt.xlsmBudsjett_resultat'!E2:E54" '<< change as required
'link to worksheet
With ThisWorkbook.Worksheets(1).Range("T2:T54")
'in this case I want the loop to find "BENGT"(which is the filename) in cell T1, and paste the values in range T2:T54.
'For the other files, I want the loop to find the filename (of the file it opened) in row 1,
'and paste the values in range ?2-?54 at the column with the same name as the filename
.Formula = mydata
.Value = .Value
WBookOther.Close SaveChanges:=False
End With
End Sub
For the password array I have tried following code:
Sub passord()
Dim myArray As Variant
myArray = ThisWorkbook.Worksheets(1).Range("B100:B116")
On Error Resume Next 'turn error reporting off
For i = LBound(myArray, 1) To UBound(myArray, 1)
Set wb = Workbooks.Open("M:\SALG\2016\Budsjett\BENGT.xlsm", Password:=myArray(i, 1))
If Not wb Is Nothing Then bOpen = True: Exit For
Next i
End Sub
I have tried to implement the last sub into the first sub, but I can't figure out how to make it work.