Read the cell value without opening the workbook [duplicate] - vba

This question already has answers here:
Open Excel file for reading with VBA without display
(10 answers)
Closed 5 years ago.
Set ObjWB = Workbooks.Open("c:\Test.xlsx")
If I used workbooks.open command, that Excel workbook opens.
I need without open that Excel workbook to read the cell value.

Run the Sub GetValue after setting the parameters in ReadFromClosedWorkbook (Workbook & Worksheet). You could pass either or both of them as arguments from the calling procedure.
Sub GetValue()
Debug.Print ReadFromClosedWorkbook("A1")
End Sub
Private Function ReadFromClosedWorkbook(Target As String) As Variant
Const WbFullName = "D:\My Documents\Your file name.xlsx"
Dim PathName As String
Dim WbName As String
Dim WsName As String
Dim Target As String
Dim Sp() As String
WsName = "My Worksheet's Name"
Sp = Split(WbFullName, "\")
WbName = Sp(UBound(Sp))
ReDim Preserve Sp(UBound(Sp) - 1)
PathName = Join(Sp, "\") & "\"
If Len(Dir(WbFullName)) Then
Target = "'" & PathName & _
"[" & WbName & "]" & WsName & _
"'!" & Range(Target).Address(True, True, xlR1C1)
ReadFromClosedWorkbook = ExecuteExcel4Macro(Target)
End If
End Function

Related

VBA Excel Ignores PrintArea Pdf

I have 250 excel documents where I try to print a sheet for pdf. If I do it manually, it will be 4 pages, but if I use my code, it will be 7 pages long.
It's like it ignores the print area, and makes several blank pages.
Can any of you figure out the mistake?
Dim wb As Workbook
Dim xExtension As String: xExtension = "*.xls*"
Dim xFolder As String: xFolder = [MailFolder]
Dim xFile As String: xFile = Dir(xFolder & xExtension) 'DIR gets the first file of the folder
Dim Rng As Range: Set Rng = Range("A1")
Dim s As String
Do While xFile <> "" 'Loop through all files in a folder until DIR cannot find anymore
Set wb = Workbooks.Open(xFolder & xFile): wb.Activate
Call WorksheetsToPDF(wb, "F:\VBA\PDF\Udlejning\" & CleanFileName("Police - " & "2021 -" & [KompletPoliceNr] & " - " & [Forsikringstager]) & ".pdf", "Certifikat")
'Call WorksheetsToPDF(wb, "F:\VBA\KF Begæringer\" & CleanFileName("KF Begæring-2021-" & [KompletPoliceNr] & "-" & [Forsikringstager]) & ".pdf", "Police")
wb.Close savechanges:=False
xFile = Dir()
Loop
End Sub
Private Sub WorksheetsToPDF(wb As Workbook, DistinationPath As String, ParamArray Arr() As Variant)
wb.Sheets(Arr()).Select
Debug.Print EFDK.GetNextavailablefilename(DistinationPath)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=EFDK.GetNextavailablefilename(DistinationPath), Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
End Sub
Private Function GetNextAvailableFilename(ByVal xPath As String) As String
With CreateObject("Scripting.FileSystemObject")
Dim strFolder As String, strBaseName As String, strExt As String, i As Long
strFolder = .GetParentFolderName(xPath)
strBaseName = .GetBaseName(xPath)
strExt = .GetExtensionName(xPath)
Do While .FileExists(xPath)
i = i + 1
xPath = .BuildPath(strFolder, strBaseName & " - " & i & "." & strExt)
Loop
End With
GetNextAvailableFilename = xPath
End Function
You did not answer my clarification questions...
Just for the sake of testing, please try the next adapted function:
Private Sub WorksheetsToPDF(wb As Workbook, DistinationPath As String, ParamArray arr() As Variant)
Dim El
wb.Sheets(arr()).Select
For Each El In arr()
wb.Sheets(El).PageSetup.FitToPagesWide = 1
wb.Sheets(El).PageSetup.PaperSize = xlPaperA4 ' xlPaperLetter
wb.Sheets(El).PageSetup.Orientation = xlLandscape
Next
'Debug.Print EFDK.GetNextavailablefilename(DistinationPath)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=EFDK.GetNextavailablefilename(DistinationPath), Quality:=xlQualityStandard, IncludeDocProperties:=True
End Sub

Get value from closed worksheet using cell value as name

I have now searched this (and other websites) for a few days and I give up trying on my own.
My code does not want to give me values:
Error 1004 unable to get the Vlookup property of the
WorksheetFunction class.
I don't want to open the other workbook to get the values, because I am making this sheet for others and they will basically freak out if something just pops up.
The code is as follows:
Sub CashHoldings()
Dim RapportBok As Workbook
Dim RapportArk As Worksheet
Dim TradeFile As Worksheet
Set RapportBok = Workbooks("Rapport kunder")
Set RapportArk = RapportBok.Sheets(1)
Set TradeFile = Workbooks("Trade File Master 1").Sheets("Trade file")
Dim wbPath As String, wbName As String
Dim wsName As String, cellRef As String
Dim Ret As String
Dim cash As Long
'wbPath = "F:\Oppgjør\Dagens trades\Dagen cash\"
wbPath = "F:\Oppgjør\Dagens trades\Dagen cash\"
wbName = RapportArk.Range("I2") & ".xlsx"
wsName = "Kontantbeholdning Makro"
cellRef = "L:N"
Ret = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True)
MsgBox Ret
cash = Application.WorksheetFunction.VLookup(RapportArk.Range("C2"), Ret, 2,
False)
End Sub
I get the correct name under Ret i.e. : 'F:\Oppgjør\Dagens trades\Dagens cash\[26.04.2017.xlsx]\Kontantbeholdning Makro'!$L:$N
What am I missing??
Thank you in advance :)
Mille

Save as CSV saves file with formulas as #NAME?

I have a module function in this report that concatenates certain cells:
Function AnalysisResults(Specs As Range, Results As Range)
AnalysisResults = Join(Specs) & ";" & Replace(Join(Results), ",", ".")
End Function
Private Function Join(Range As Range, Optional ByRef Delimeter As String = " ")
Dim Str As String
For Each cell In Range
If Str <> "" Then Str = Str & Delimeter
Str = Str & cell.Value
Next
Join = Str
End Function
Then i have a command button that save my file as CSV. It works, but the where the function cells are the value saved is #NAME?.
If I Save As manually as CSV comma delimited, it saves correctly and the formula values appears.
Here is the code of the CommandButton:
Dim myValue As Variant
myValue = InputBox("Specifica numele WBT-ului de descarcare:", "Save WBT with the following name", 1)
Range("L2").Value = myValue
Dim CopyToCSV()
Dim MyPath As String
Dim MyFileName As String
Sheets("Manual Discharge WBT").EnableCalculation = True
MyPath = "\\FILES\Transfer\~~TTS Import (do not delete)~~\Import Files\"
MyFileName = Range("L2") & " Discharge " & Format(CStr(Now), " dd_mm_yyyy_hh_mm")
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
If Not Right(MyFileName, 4) = ".csv" Then MyFileName = MyFileName & ".csv"
Sheets("Manual Discharge WBT").Copy
With ActiveWorkbook
.SaveAs Filename:= _
MyPath & MyFileName, _
FileFormat:=xlCSVWindows, _
CreateBackup:=False
.Close False
MsgBox "Fisierul tau s-a salvat ca: " & MyFileName
End With
The solution is, you will have to save your AnalysisResults and Join functions as an add-in file .xlam and add to excel at Developer->Add-ins. Doing it this way the above code worked for me when saving to CSV without #NAME?
What was happening here was that when excel is trying to save the file to CSV, it doesn't know what the AnalysisResults function is.

Read a value from a cell without opening the Workbook [duplicate]

I found this bit of code and thought it might be good to use if I just need to pull one value from a closed sheet.
strInfoCell = "'" & strPath & "[" & strFile & "]Sheet1'!R3C3"
myvalue = ExecuteExcel4Macro(strInfoCell)
When I run this code I get a value for strinfocell of
'C:\Users\my.name\Desktop[QOS DGL stuff.xlsx]Sheet1'!R3C3
But when I run the code a dialogue pops up, showing desktop files with "QOS DGL suff" showing.
What's causing this, why is it not just pulling back the data as expected?
I know the path and file name are right, because if I copy them from the debug output and paste them in to start>>run then the correct sheet opens.
I know that Sheet1 (named: ACL), does have a value in cells(3,3)
It depends on how you use it. The open file dialog box is being showed to you because the "strPath" doesn't have a "" in the end ;)
Try this code.
Option Explicit
Sub Sample()
Dim wbPath As String, wbName As String
Dim wsName As String, cellRef As String
Dim Ret As String
'wbPath = "C:\Documents and Settings\Siddharth Rout\Desktop\"
wbPath = "C:\Users\my.name\Desktop\"
wbName = "QOS DGL stuff.xls"
wsName = "ACL"
cellRef = "C3"
Ret = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, -4150)
MsgBox ExecuteExcel4Macro(Ret)
End Sub
Similar application, but no hard coded paths as in the examples above. This function copies the value from another closed workbook, similar to the =INDIRECT() function, but not as sophisticated. This only returns the value...not a reference..so it cannot be used with further functions which require references (i.e.: VLOOKUP()). Paste this code into a new VBA module:
'Requires filename, sheetname as first argument and cell reference as second argument
'Usage: type in an excel cell -> =getvalue(A1,B1)
'Example of A1 -> C:\TEMP\[FILE1.XLS]SHEET1'
'Example of B1 -> B3
'This will fetch contents of cell (B3) located in (sheet1) of (c:\temp\file1.xls)
'Create a module and paste the code into the module (e.g. Module1, Module2)
Public xlapp As Object
Public Function getvalue(ByVal filename As String, ref As String) As Variant
' Retrieves a value from a closed workbook
Dim arg As String
Dim path As String
Dim file As String
filename = Trim(filename)
path = Mid(filename, 1, InStrRev(filename, "\"))
file = Mid(filename, InStr(1, filename, "[") + 1, InStr(1, filename, "]") - InStr(1, filename, "[") - 1)
If Dir(path & file) = "" Then
getvalue = "File Not Found"
Exit Function
End If
If xlapp Is Nothing Then
'Object must be created only once and not at each function call
Set xlapp = CreateObject("Excel.application")
End If
' Create the argument
arg = "'" & filename & "'!" & Range(ref).Range("A1").Address(, , xlR1C1)
'Execute an XLM macro
getvalue = xlapp.ExecuteExcel4Macro(arg)
End Function
Code above
strInfoCell = "'" & strPath & "[" & strFile & "]Sheet1'!R3C3"
myvalue = ExecuteExcel4Macro(strInfoCell)
Should read
strInfoCell = "'" & strPath & "[" & strFile & "]" & "Sheet1'!R3C3"
myvalue = ExecuteExcel4Macro(strInfoCell)
It is missing " & "
No need for a function
Cheers
Neil
Data = "'" & GetDirectory & "[" & GetFileName & "]" & Sheet & "'!" & Range(Address).Range("A1").Address(, , xlR1C1)
Address = "$C$3"
GetDirectory = "C:\Users\my.name\Desktop\"
GetFileName = "QOS DGL stuff.xlsx"
Sheet = "ACL"

How can I read information from a specific cell in a closed workbook then paste it in a cell in my active worksheet using VBA in Microsoft Excel?

I was wondering if anyone knew how one can reference a cell from a closed workbook using VBA.
I know how to reference a range of cells using ADO and SQL but I don't know how to create a SQL query for a specific cell.
While browsing the internet i came across some code that uses "ExecuteExcel4Macro" but I am unable to find any real documentation for this function/command. In fact the documentation on the MSDN website regarding this command is rubbish and vague and quit frankly not helpful at all.
Anyway I digress; Ideally, I would like to call on a cell from an external workbook without having to open said workbook. The code I am trying to get to work is as follows:
Sub update_overview()
Dim wbPath As String
Dim wbName As String
Dim wsName As String
Dim cellRef As String
Dim data As Variant
wbPath = "C:\examplepath\"
wbName = "Core (N)i.xls"
wsName = "Sheet1"
cellRef = "C5"
'data = GetData(wbPath, wbName, wsName, cellRef)
ThisWorkbook.Activate
Sheets("Overview").Select
With Selection
ActiveSheet.Range("C5").Clear
ActiveSheet.Range("C5").Select
ActiveCell = GetData(wbPath, wbName, wsName, cellRef)
End With
End Sub
Private Function GetData(ByVal wbPath As String, _
wbName As String, wsName As String, cellRef As String) As Variant
Dim arg As String
GetData = ""
arg = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1)
GetData = ExecuteExcel4Macro(arg)
End Function
When i run the macro the only thing it returns is #REF
I have also tried:
Sub Sample()
Dim wbPath As String, wbName As String
Dim wsName As String, cellRef As String
Dim Ret As String
'wbPath = "C:\Documents and Settings\Siddharth Rout\Desktop\"
wbPath = "C:\Users\my.name\Desktop\"
wbName = "QOS DGL stuff.xls"
wsName = "ACL"
cellRef = "C3"
Ret = "'" & wbPath & "[" & wbName & "]" & _
wsName & "'!" & Range(cellRef).Address(True, True, -4150)
MsgBox ExecuteExcel4Macro(Ret)
End Sub
When the code reaches MsgBox I get a type missmatch error. If i get rid of the msgbox command and try to continue to paste to the cell with
ThisWorkbook.Activate
Sheets("Overview").Select
With Selection
ActiveSheet.Range("C5").Clear
ActiveSheet.Range("C5").Select
ActiveCell = ExecuteExcel4Macro(Ret)
I still get the #REF! error
Can anyone tell me:
1) is this the best technique to be using?
2) What is wrong with my code? and,
3) Is there a better way to reference a single cell from an external workbook using ADO or DOA or a technique i am unaware of.
Also does anyone know of any extensive documentation on how to use the ExecuteExcel4Macro function.
Please help; Thanks
FYI I am on excel 2003
You could try something like this:
arg = "='" & wbPath & "[" & wbName & "]" & wsName & "'!" & cellRef
Sub Test()
Dim wbName As String
Dim wbPath As String
Dim wsName As String
Dim cellRef As String
Dim calcState As Long
calcState = Application.Calculation
wbPath = "C:\users\david_zemens\"
wbName = "a report.xlsx"
wsName = "Sheet1"
cellRef = Range("B2").Address
Dim arg As String
arg = "='" & wbPath & "[" & wbName & "]" & wsName & "'!" & cellRef 'Range(cellRef).Address(True, True, xlR1C1)
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
ActiveCell.Value = arg
ActiveCell.Value = ActiveCell.Value 'essentially a paste/values over the formula.
Application.DisplayAlerts = True
Application.Calculation = calcState
End Sub