简体   繁体   中英

Function to open excel file and get value in specific cell vba

I'm trying to use VBA to read in a filename of an excel file, open it, get a value in it, and write the value into a cell in my main excel file.

Specifically, in one excel sheet, named GetValues.xlsm, I have in cell "A1" the name of a file, "Test1.xlsx". I am trying to open this file, then assign the value in cell "A1" to cell "B1" in GetValues.xlsm. I am trying to use a function, below, to do this;

Function Getvalue(myFile)
'Dim myPath As String
'Dim myExtension As String
myPath = Application.ActiveWorkbook.Path & "\"
myFile = myPath & myFile
Workbooks.Open myFile
Debug.Print "myFile: "; myFile
Debug.Print "ActiveWorkbook: "; ActiveWorkbook.Name
'Val = ActiveWorkbook.Worksheets(1).Range("A1").Value
GetValue = 1
End Function

So that in cell "B1" of GetValues.xlsm I type

=GetValue(A2)

which gives me the result:

myFile: G:\Teaching-CAL\MAE343-CompressibleFlow\04_Codes\LVL\Test1.xlsx
ActiveWorkbook: GetValues.xlsm

My issue is that I'm expecting ActiveWorkbook to be the Test1.xlsx file, but as you can see in the output it is giving me GetValues.xlsm.

I assign the value of 1 to "GetValue" so I can attempt to debug this function.

Thanks in advance for your help.

You'd need to call your function from a sub, not as a UDF from a worksheet cell:

Sub ProcessPaths()
    Dim c As Range
    'loop over cells with file paths
    For Each c In ActiveSheet.Range("A1:A10") 'for example
        c.Offset(0, 1).Value = GetValue(c.Value) 'populate ColB
    Next c
End Sub

Function GetValue(myFile)
    If Len(Dir(myFile)) > 0 Then
        With Workbooks.Open(myFile, ReadOnly:=True)
            'GetValue = .Worksheets(1).Range("A1").Value  'read from cell
            GetValue = .Worksheets(1).Evaluate( _
                         "=SUMIF(B1:B50,""Current"",A1:A50)") 'execute a function
            .Close False
        End With
    Else
        GetValue = "File?"
    End If
End Function

If it's OK with you to fill cell B1 of "GetValues.xlsm" active sheet with the value of cell A1 in "Test1.xlsx" without UDF and without opening "Test1.xlsx" workbook :

Sub test()
Dim p As String: Dim f As String
Dim s As String: Dim c As String
    p = ThisWorkbook.Path & "\" 'the path directory
    f = Range("A1").Value 'the name of the file
    s = "Sheet1" 'the name of the sheet
    c = "a1" 'the cell
    Ret = "'" & p & "[" & f & "]" & _
          s & "'!" & Range(c).Address(True, True, -4150)
    Range("B1").Value = ExecuteExcel4Macro(Ret)
End Sub

The sub above will fill cell B1 of "GetValues.xlsm" active sheet with the value of cell A1 sheet1 of whatever_the_name_of_the_ExcelFile you wrote in cell A1 of "GetValues.xlsm" active sheet without opening that whatever_the_name_of_the_ExcelFile.

"GetValues.xlsm" must be in the same folder with whatever_the_name_of_the_ExcelFile.

Do not use ActiveWorkbook, instead assign the opened workbook to a Variable

Function Getvalue(myFile)
    'Dim myPath As String
    'Dim myExtension As String
    Dim valueWorkbook As Workbook
    'The less you use ActiveWorkbook the better
    'use ThisWorkbook to refer to the workbook that contains the Code
    myPath = Application.ThisWorkbook.Path & "\"
    myFile = myPath & myFile
    Set valueWorkbook = Workbooks.Open(myFile)
    Debug.Print "myFile: " & myFile
    Debug.Print "ActiveWorkbook/ValueWorkbook: " & valueWorkbook.Name
    cellValue = valueWorkbook.Worksheets(1).Range("A1").Value
    MsgBox "Value in Range A1 is: " & cellValue & " of file: " & valueWorkbook.Name
    GetValue = 1
End Function

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM